anil.recoil.org
OCaml library for JSONfeed parsing and creation
ocamlformat
+10
-15
example/feed_echo.ml
+10
-15
example/feed_echo.ml
···
1
1
(** Example: JSON Feed Echo
2
2
3
-
Reads a JSON Feed from stdin, parses it, and outputs it to stdout.
4
-
Useful for testing round-trip parsing and identifying any changes
5
-
during serialization/deserialization.
3
+
Reads a JSON Feed from stdin, parses it, and outputs it to stdout. Useful
4
+
for testing round-trip parsing and identifying any changes during
5
+
serialization/deserialization.
6
6
7
-
Usage:
8
-
feed_echo < feed.json
9
-
cat feed.json | feed_echo > output.json
10
-
diff <(cat feed.json | feed_echo) feed.json
7
+
Usage: feed_echo < feed.json cat feed.json | feed_echo > output.json diff
8
+
<(cat feed.json | feed_echo) feed.json
11
9
12
-
Exit codes:
13
-
0 - Success
14
-
1 - Parsing or encoding failed *)
10
+
Exit codes: 0 - Success 1 - Parsing or encoding failed *)
15
11
16
12
let echo_feed () =
17
13
(* Create a bytesrw reader from stdin *)
···
22
18
| Error err ->
23
19
Format.eprintf "Parsing failed:\n %s\n%!" (Jsont.Error.to_string err);
24
20
exit 1
25
-
26
-
| Ok feed ->
21
+
| Ok feed -> (
27
22
(* Encode the feed back to stdout *)
28
23
match Jsonfeed.to_string ~minify:false feed with
29
24
| Error err ->
30
-
Format.eprintf "Encoding failed:\n %s\n%!" (Jsont.Error.to_string err);
25
+
Format.eprintf "Encoding failed:\n %s\n%!"
26
+
(Jsont.Error.to_string err);
31
27
exit 1
32
-
33
28
| Ok json ->
34
29
print_string json;
35
30
print_newline ();
36
-
exit 0
31
+
exit 0)
37
32
38
33
let () = echo_feed ()
+95
-105
example/feed_example.ml
+95
-105
example/feed_example.ml
···
13
13
match Jsonfeed.to_string feed with
14
14
| Ok s ->
15
15
Out_channel.with_open_gen
16
-
[Open_wronly; Open_creat; Open_trunc; Open_text]
17
-
0o644
18
-
filename
16
+
[ Open_wronly; Open_creat; Open_trunc; Open_text ] 0o644 filename
19
17
(fun oc -> Out_channel.output_string oc s)
20
18
| Error e ->
21
19
Printf.eprintf "Error encoding feed: %s\n" (Jsont.Error.to_string e);
···
23
21
24
22
let create_blog_feed () =
25
23
(* Create some authors *)
26
-
let jane = Author.create
27
-
~name:"Jane Doe"
28
-
~url:"https://example.com/authors/jane"
29
-
~avatar:"https://example.com/avatars/jane.png"
30
-
() in
24
+
let jane =
25
+
Author.create ~name:"Jane Doe" ~url:"https://example.com/authors/jane"
26
+
~avatar:"https://example.com/avatars/jane.png" ()
27
+
in
31
28
32
-
let john = Author.create
33
-
~name:"John Smith"
34
-
~url:"https://example.com/authors/john"
35
-
() in
29
+
let john =
30
+
Author.create ~name:"John Smith" ~url:"https://example.com/authors/john" ()
31
+
in
36
32
37
33
(* Create items with different content types *)
38
-
let item1 = Item.create
39
-
~id:"https://example.com/posts/1"
40
-
~url:"https://example.com/posts/1"
41
-
~title:"Introduction to OCaml"
42
-
~content:(`Both (
43
-
"<p>OCaml is a powerful functional programming language.</p>",
44
-
"OCaml is a powerful functional programming language."
45
-
))
46
-
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get)
47
-
~date_modified:(Jsonfeed.Rfc3339.parse "2024-11-01T15:30:00Z" |> Option.get)
48
-
~authors:[jane]
49
-
~tags:["ocaml"; "programming"; "functional"]
50
-
~summary:"A beginner's guide to OCaml programming"
51
-
() in
34
+
let item1 =
35
+
Item.create ~id:"https://example.com/posts/1"
36
+
~url:"https://example.com/posts/1" ~title:"Introduction to OCaml"
37
+
~content:
38
+
(`Both
39
+
( "<p>OCaml is a powerful functional programming language.</p>",
40
+
"OCaml is a powerful functional programming language." ))
41
+
~date_published:
42
+
(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get)
43
+
~date_modified:
44
+
(Jsonfeed.Rfc3339.parse "2024-11-01T15:30:00Z" |> Option.get)
45
+
~authors:[ jane ]
46
+
~tags:[ "ocaml"; "programming"; "functional" ]
47
+
~summary:"A beginner's guide to OCaml programming" ()
48
+
in
52
49
53
-
let item2 = Item.create
54
-
~id:"https://example.com/posts/2"
55
-
~url:"https://example.com/posts/2"
56
-
~title:"JSON Feed for Syndication"
57
-
~content:(`Html "<p>JSON Feed is a modern alternative to RSS and Atom.</p>")
58
-
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-02T09:00:00Z" |> Option.get)
59
-
~authors:[jane; john]
60
-
~tags:["json"; "syndication"; "web"]
61
-
~image:"https://example.com/images/jsonfeed.png"
62
-
() in
50
+
let item2 =
51
+
Item.create ~id:"https://example.com/posts/2"
52
+
~url:"https://example.com/posts/2" ~title:"JSON Feed for Syndication"
53
+
~content:
54
+
(`Html "<p>JSON Feed is a modern alternative to RSS and Atom.</p>")
55
+
~date_published:
56
+
(Jsonfeed.Rfc3339.parse "2024-11-02T09:00:00Z" |> Option.get)
57
+
~authors:[ jane; john ]
58
+
~tags:[ "json"; "syndication"; "web" ]
59
+
~image:"https://example.com/images/jsonfeed.png" ()
60
+
in
63
61
64
62
(* Microblog-style item (text only, no title) *)
65
-
let item3 = Item.create
66
-
~id:"https://example.com/micro/42"
67
-
~content:(`Text "Just shipped a new feature! 🚀")
68
-
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-03T08:15:00Z" |> Option.get)
69
-
~tags:["microblog"]
70
-
() in
63
+
let item3 =
64
+
Item.create ~id:"https://example.com/micro/42"
65
+
~content:(`Text "Just shipped a new feature! 🚀")
66
+
~date_published:
67
+
(Jsonfeed.Rfc3339.parse "2024-11-03T08:15:00Z" |> Option.get)
68
+
~tags:[ "microblog" ] ()
69
+
in
71
70
72
71
(* Create the complete feed *)
73
-
let feed = Jsonfeed.create
74
-
~title:"Example Blog"
75
-
~home_page_url:"https://example.com"
76
-
~feed_url:"https://example.com/feed.json"
77
-
~description:"A blog about programming, web development, and technology"
78
-
~icon:"https://example.com/icon-512.png"
79
-
~favicon:"https://example.com/favicon-64.png"
80
-
~authors:[jane; john]
81
-
~language:"en-US"
82
-
~items:[item1; item2; item3]
83
-
() in
72
+
let feed =
73
+
Jsonfeed.create ~title:"Example Blog" ~home_page_url:"https://example.com"
74
+
~feed_url:"https://example.com/feed.json"
75
+
~description:"A blog about programming, web development, and technology"
76
+
~icon:"https://example.com/icon-512.png"
77
+
~favicon:"https://example.com/favicon-64.png" ~authors:[ jane; john ]
78
+
~language:"en-US" ~items:[ item1; item2; item3 ] ()
79
+
in
84
80
85
81
feed
86
82
87
83
let create_podcast_feed () =
88
84
(* Create podcast author *)
89
-
let host = Author.create
90
-
~name:"Podcast Host"
91
-
~url:"https://podcast.example.com/host"
92
-
~avatar:"https://podcast.example.com/host-avatar.jpg"
93
-
() in
85
+
let host =
86
+
Author.create ~name:"Podcast Host" ~url:"https://podcast.example.com/host"
87
+
~avatar:"https://podcast.example.com/host-avatar.jpg" ()
88
+
in
94
89
95
90
(* Create episode with audio attachment *)
96
-
let attachment = Attachment.create
97
-
~url:"https://podcast.example.com/episodes/ep1.mp3"
98
-
~mime_type:"audio/mpeg"
99
-
~title:"Episode 1: Introduction"
100
-
~size_in_bytes:15_728_640L
101
-
~duration_in_seconds:1800
102
-
() in
91
+
let attachment =
92
+
Attachment.create ~url:"https://podcast.example.com/episodes/ep1.mp3"
93
+
~mime_type:"audio/mpeg" ~title:"Episode 1: Introduction"
94
+
~size_in_bytes:15_728_640L ~duration_in_seconds:1800 ()
95
+
in
103
96
104
-
let episode = Item.create
105
-
~id:"https://podcast.example.com/episodes/1"
106
-
~url:"https://podcast.example.com/episodes/1"
107
-
~title:"Episode 1: Introduction"
108
-
~content:(`Html "<p>Welcome to our first episode!</p>")
109
-
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T12:00:00Z" |> Option.get)
110
-
~attachments:[attachment]
111
-
~authors:[host]
112
-
~image:"https://podcast.example.com/episodes/ep1-cover.jpg"
113
-
() in
97
+
let episode =
98
+
Item.create ~id:"https://podcast.example.com/episodes/1"
99
+
~url:"https://podcast.example.com/episodes/1"
100
+
~title:"Episode 1: Introduction"
101
+
~content:(`Html "<p>Welcome to our first episode!</p>")
102
+
~date_published:
103
+
(Jsonfeed.Rfc3339.parse "2024-11-01T12:00:00Z" |> Option.get)
104
+
~attachments:[ attachment ] ~authors:[ host ]
105
+
~image:"https://podcast.example.com/episodes/ep1-cover.jpg" ()
106
+
in
114
107
115
108
(* Create podcast feed with hub for real-time updates *)
116
-
let hub = Hub.create
117
-
~type_:"WebSub"
118
-
~url:"https://pubsubhubbub.appspot.com/"
119
-
() in
109
+
let hub =
110
+
Hub.create ~type_:"WebSub" ~url:"https://pubsubhubbub.appspot.com/" ()
111
+
in
120
112
121
-
let feed = Jsonfeed.create
122
-
~title:"Example Podcast"
123
-
~home_page_url:"https://podcast.example.com"
124
-
~feed_url:"https://podcast.example.com/feed.json"
125
-
~description:"A podcast about interesting topics"
126
-
~icon:"https://podcast.example.com/icon.png"
127
-
~authors:[host]
128
-
~language:"en-US"
129
-
~hubs:[hub]
130
-
~items:[episode]
131
-
() in
113
+
let feed =
114
+
Jsonfeed.create ~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" ~authors:[ host ]
119
+
~language:"en-US" ~hubs:[ hub ] ~items:[ episode ] ()
120
+
in
132
121
133
122
feed
134
123
···
139
128
140
129
(* Serialize to string *)
141
130
(match Jsonfeed.to_string blog_feed with
142
-
| Ok json_string ->
143
-
Format.printf "JSON (first 200 chars): %s...\n\n"
144
-
(String.sub json_string 0 (min 200 (String.length json_string)))
145
-
| Error e ->
146
-
Printf.eprintf "Error serializing to string: %s\n" (Jsont.Error.to_string e);
147
-
exit 1);
131
+
| Ok json_string ->
132
+
Format.printf "JSON (first 200 chars): %s...\n\n"
133
+
(String.sub json_string 0 (min 200 (String.length json_string)))
134
+
| Error e ->
135
+
Printf.eprintf "Error serializing to string: %s\n"
136
+
(Jsont.Error.to_string e);
137
+
exit 1);
148
138
149
139
(* Serialize to file *)
150
140
to_file "blog-feed.json" blog_feed;
···
156
146
157
147
(* Validate feeds *)
158
148
(match Jsonfeed.validate blog_feed with
159
-
| Ok () -> Format.printf "✓ Blog feed is valid\n"
160
-
| Error errors ->
161
-
Format.printf "✗ Blog feed validation errors:\n";
162
-
List.iter (Format.printf " - %s\n") errors);
149
+
| Ok () -> Format.printf "✓ Blog feed is valid\n"
150
+
| Error errors ->
151
+
Format.printf "✗ Blog feed validation errors:\n";
152
+
List.iter (Format.printf " - %s\n") errors);
163
153
164
-
(match Jsonfeed.validate podcast_feed with
165
-
| Ok () -> Format.printf "✓ Podcast feed is valid\n"
166
-
| Error errors ->
167
-
Format.printf "✗ Podcast feed validation errors:\n";
168
-
List.iter (Format.printf " - %s\n") errors)
154
+
match Jsonfeed.validate podcast_feed with
155
+
| Ok () -> Format.printf "✓ Podcast feed is valid\n"
156
+
| Error errors ->
157
+
Format.printf "✗ Podcast feed validation errors:\n";
158
+
List.iter (Format.printf " - %s\n") errors
169
159
170
160
let () = main ()
+88
-88
example/feed_parser.ml
+88
-88
example/feed_parser.ml
···
19
19
Format.printf " Version: %s\n" (Jsonfeed.version feed);
20
20
21
21
(match Jsonfeed.home_page_url feed with
22
-
| Some url -> Format.printf " Home Page: %s\n" url
23
-
| None -> ());
22
+
| Some url -> Format.printf " Home Page: %s\n" url
23
+
| None -> ());
24
24
25
25
(match Jsonfeed.feed_url feed with
26
-
| Some url -> Format.printf " Feed URL: %s\n" url
27
-
| None -> ());
26
+
| Some url -> Format.printf " Feed URL: %s\n" url
27
+
| None -> ());
28
28
29
29
(match Jsonfeed.description feed with
30
-
| Some desc -> Format.printf " Description: %s\n" desc
31
-
| None -> ());
30
+
| Some desc -> Format.printf " Description: %s\n" desc
31
+
| None -> ());
32
32
33
33
(match Jsonfeed.language feed with
34
-
| Some lang -> Format.printf " Language: %s\n" lang
35
-
| None -> ());
34
+
| Some lang -> Format.printf " Language: %s\n" lang
35
+
| None -> ());
36
36
37
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
38
+
| Some authors ->
39
+
Format.printf " Authors:\n";
40
+
List.iter
41
+
(fun author ->
42
+
match Author.name author with
43
+
| Some name ->
44
+
Format.printf " - %s" name;
45
+
(match Author.url author with
44
46
| Some url -> Format.printf " (%s)" url
45
47
| None -> ());
46
-
Format.printf "\n"
47
-
| None -> ()
48
-
) authors
49
-
| None -> ());
48
+
Format.printf "\n"
49
+
| None -> ())
50
+
authors
51
+
| None -> ());
50
52
51
53
Format.printf " Items: %d\n\n" (List.length (Jsonfeed.items feed))
52
54
···
54
56
Format.printf "Item: %s\n" (Item.id item);
55
57
56
58
(match Item.title item with
57
-
| Some title -> Format.printf " Title: %s\n" title
58
-
| None -> Format.printf " (No title - microblog entry)\n");
59
+
| Some title -> Format.printf " Title: %s\n" title
60
+
| None -> Format.printf " (No title - microblog entry)\n");
59
61
60
62
(match Item.url item with
61
-
| Some url -> Format.printf " URL: %s\n" url
62
-
| None -> ());
63
+
| Some url -> Format.printf " URL: %s\n" url
64
+
| None -> ());
63
65
64
66
(* Print content info *)
65
67
(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));
68
+
| `Html html ->
69
+
Format.printf " Content: HTML only (%d chars)\n" (String.length html)
70
+
| `Text text ->
71
+
Format.printf " Content: Text only (%d chars)\n" (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
75
76
76
(* Print dates *)
77
77
(match Item.date_published item with
78
-
| Some date ->
79
-
Format.printf " Published: %s\n"
80
-
(Jsonfeed.Rfc3339.format date)
81
-
| None -> ());
78
+
| Some date ->
79
+
Format.printf " Published: %s\n" (Jsonfeed.Rfc3339.format date)
80
+
| None -> ());
82
81
83
82
(match Item.date_modified item with
84
-
| Some date ->
85
-
Format.printf " Modified: %s\n"
86
-
(Jsonfeed.Rfc3339.format date)
87
-
| None -> ());
83
+
| Some date -> Format.printf " Modified: %s\n" (Jsonfeed.Rfc3339.format date)
84
+
| None -> ());
88
85
89
86
(* Print tags *)
90
87
(match Item.tags item with
91
-
| Some tags when tags <> [] ->
92
-
Format.printf " Tags: %s\n" (String.concat ", " tags)
93
-
| _ -> ());
88
+
| Some tags when tags <> [] ->
89
+
Format.printf " Tags: %s\n" (String.concat ", " tags)
90
+
| _ -> ());
94
91
95
92
(* Print attachments *)
96
93
(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
94
+
| Some attachments when attachments <> [] ->
95
+
Format.printf " Attachments:\n";
96
+
List.iter
97
+
(fun att ->
98
+
Format.printf " - %s (%s)\n" (Attachment.url att)
99
+
(Attachment.mime_type att);
100
+
(match Attachment.size_in_bytes att with
104
101
| Some size ->
105
102
let mb = Int64.to_float size /. (1024. *. 1024.) in
106
103
Format.printf " Size: %.2f MB\n" mb
107
104
| None -> ());
108
-
(match Attachment.duration_in_seconds att with
105
+
match Attachment.duration_in_seconds att with
109
106
| Some duration ->
110
107
let mins = duration / 60 in
111
108
let secs = duration mod 60 in
112
109
Format.printf " Duration: %dm%ds\n" mins secs
113
110
| None -> ())
114
-
) attachments
115
-
| _ -> ());
111
+
attachments
112
+
| _ -> ());
116
113
117
114
Format.printf "\n"
118
115
···
126
123
let text_only = ref 0 in
127
124
let both = ref 0 in
128
125
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;
126
+
List.iter
127
+
(fun item ->
128
+
match Item.content item with
129
+
| `Html _ -> incr html_only
130
+
| `Text _ -> incr text_only
131
+
| `Both _ -> incr both)
132
+
items;
135
133
136
134
Format.printf "Content Types:\n";
137
135
Format.printf " HTML only: %d\n" !html_only;
···
139
137
Format.printf " Both: %d\n\n" !both;
140
138
141
139
(* 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
140
+
let with_attachments =
141
+
List.filter
142
+
(fun item ->
143
+
match Item.attachments item with
144
+
| Some att when att <> [] -> true
145
+
| _ -> false)
146
+
items
147
+
in
147
148
148
149
Format.printf "Items with attachments: %d\n\n" (List.length with_attachments);
149
150
150
151
(* 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
152
+
let all_tags =
153
+
List.fold_left
154
+
(fun acc item ->
155
+
match Item.tags item with Some tags -> acc @ tags | None -> acc)
156
+
[] items
157
+
in
156
158
let unique_tags = List.sort_uniq String.compare all_tags in
157
159
158
-
if unique_tags <> [] then (
160
+
if unique_tags <> [] then
159
161
Format.printf "All tags used: %s\n\n" (String.concat ", " unique_tags)
160
-
)
161
162
162
163
let main () =
163
164
(* Parse from example_feed.json file *)
164
165
Format.printf "=== Parsing JSON Feed from example_feed.json ===\n\n";
165
166
166
-
(try
167
+
try
167
168
match of_file "example/example_feed.json" with
168
-
| Ok feed ->
169
+
| Ok feed -> (
169
170
print_feed_info feed;
170
171
171
172
Format.printf "=== Items ===\n\n";
···
175
176
176
177
(* Demonstrate round-trip parsing *)
177
178
Format.printf "\n=== Round-trip Test ===\n\n";
178
-
(match Jsonfeed.to_string feed with
179
-
| Error e ->
180
-
Printf.eprintf "Error serializing feed: %s\n" (Jsont.Error.to_string e);
181
-
exit 1
182
-
| Ok json ->
183
-
match Jsonfeed.of_string json with
184
-
| Ok feed2 ->
185
-
if Jsonfeed.equal feed feed2 then
186
-
Format.printf "✓ Round-trip successful: feeds are equal\n"
187
-
else
188
-
Format.printf "✗ Round-trip failed: feeds differ\n"
189
-
| Error err ->
190
-
Format.eprintf "✗ Round-trip failed: %s\n" (Jsont.Error.to_string err))
179
+
match Jsonfeed.to_string feed with
180
+
| Error e ->
181
+
Printf.eprintf "Error serializing feed: %s\n"
182
+
(Jsont.Error.to_string e);
183
+
exit 1
184
+
| Ok json -> (
185
+
match Jsonfeed.of_string json with
186
+
| Ok feed2 ->
187
+
if Jsonfeed.equal feed feed2 then
188
+
Format.printf "✓ Round-trip successful: feeds are equal\n"
189
+
else Format.printf "✗ Round-trip failed: feeds differ\n"
190
+
| Error err ->
191
+
Format.eprintf "✗ Round-trip failed: %s\n"
192
+
(Jsont.Error.to_string err)))
191
193
| Error err ->
192
194
Format.eprintf "Error parsing feed: %s\n" (Jsont.Error.to_string err)
193
-
with
194
-
| Sys_error msg ->
195
-
Format.eprintf "Error reading file: %s\n" msg)
195
+
with Sys_error msg -> Format.eprintf "Error reading file: %s\n" msg
196
196
197
197
let () = main ()
+7
-12
example/feed_validator.ml
+7
-12
example/feed_validator.ml
···
2
2
3
3
Reads a JSON Feed from stdin and validates it.
4
4
5
-
Usage:
6
-
feed_validator < feed.json
7
-
cat feed.json | feed_validator
5
+
Usage: feed_validator < feed.json cat feed.json | feed_validator
8
6
9
-
Exit codes:
10
-
0 - Feed is valid
11
-
1 - Feed parsing failed
12
-
2 - Feed validation failed *)
7
+
Exit codes: 0 - Feed is valid 1 - Feed parsing failed 2 - Feed validation
8
+
failed *)
13
9
14
10
let validate_stdin () =
15
11
let stdin = Bytesrw.Bytes.Reader.of_in_channel In_channel.stdin in
···
17
13
| Error err ->
18
14
Format.eprintf "Parsing failed:\n %s\n%!" (Jsont.Error.to_string err);
19
15
exit 1
20
-
| Ok feed ->
16
+
| Ok feed -> (
21
17
match Jsonfeed.validate feed with
22
18
| Ok () ->
23
19
Format.printf "Feed is valid\n%!";
···
25
21
Format.printf " Title: %s\n" (Jsonfeed.title feed);
26
22
Format.printf " Version: %s\n" (Jsonfeed.version feed);
27
23
(match Jsonfeed.home_page_url feed with
28
-
| Some url -> Format.printf " Home page: %s\n" url
29
-
| None -> ());
24
+
| Some url -> Format.printf " Home page: %s\n" url
25
+
| None -> ());
30
26
Format.printf " Items: %d\n" (List.length (Jsonfeed.items feed));
31
27
exit 0
32
-
33
28
| Error errors ->
34
29
Format.eprintf "Validation failed:\n%!";
35
30
List.iter (fun err -> Format.eprintf " - %s\n%!" err) errors;
36
-
exit 2
31
+
exit 2)
37
32
38
33
let () = validate_stdin ()
+35
-26
lib/attachment.ml
+35
-26
lib/attachment.ml
···
19
19
unknown : Unknown.t;
20
20
}
21
21
22
-
let create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ?(unknown = Unknown.empty) () =
22
+
let create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds
23
+
?(unknown = Unknown.empty) () =
23
24
{ url; mime_type; title; size_in_bytes; duration_in_seconds; unknown }
24
25
25
26
let url t = t.url
···
30
31
let unknown t = t.unknown
31
32
32
33
let equal a b =
33
-
a.url = b.url &&
34
-
a.mime_type = b.mime_type &&
35
-
a.title = b.title &&
36
-
a.size_in_bytes = b.size_in_bytes &&
37
-
a.duration_in_seconds = b.duration_in_seconds
34
+
a.url = b.url && a.mime_type = b.mime_type && a.title = b.title
35
+
&& a.size_in_bytes = b.size_in_bytes
36
+
&& a.duration_in_seconds = b.duration_in_seconds
38
37
39
38
let pp ppf t =
40
39
(* Extract filename from URL *)
···
48
47
Format.fprintf ppf "%s (%s" filename t.mime_type;
49
48
50
49
(match t.size_in_bytes with
51
-
| Some size ->
52
-
let mb = Int64.to_float size /. (1024. *. 1024.) in
53
-
Format.fprintf ppf ", %.1f MB" mb
54
-
| None -> ());
50
+
| Some size ->
51
+
let mb = Int64.to_float size /. (1024. *. 1024.) in
52
+
Format.fprintf ppf ", %.1f MB" mb
53
+
| None -> ());
55
54
56
55
(match t.duration_in_seconds with
57
-
| Some duration ->
58
-
let mins = duration / 60 in
59
-
let secs = duration mod 60 in
60
-
Format.fprintf ppf ", %dm%ds" mins secs
61
-
| None -> ());
56
+
| Some duration ->
57
+
let mins = duration / 60 in
58
+
let secs = duration mod 60 in
59
+
Format.fprintf ppf ", %dm%ds" mins secs
60
+
| None -> ());
62
61
63
62
Format.fprintf ppf ")"
64
63
65
64
let jsont =
66
65
let kind = "Attachment" in
67
66
let doc = "An attachment object" in
68
-
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
67
+
let unknown_mems :
68
+
(Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
69
69
let open Jsont.Object.Mems in
70
70
let dec_empty () = [] in
71
71
let dec_add _meta (name : string) value acc =
72
72
((name, Jsont.Meta.none), value) :: acc
73
73
in
74
74
let dec_finish _meta mems =
75
-
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
76
-
let enc = {
77
-
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
78
-
List.fold_left (fun acc (name, value) ->
79
-
80
-
f Jsont.Meta.none name value acc
81
-
) acc unknown
82
-
} in
75
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
76
+
in
77
+
let enc =
78
+
{
79
+
enc =
80
+
(fun (type acc)
81
+
(f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc)
82
+
unknown
83
+
(acc : acc)
84
+
->
85
+
List.fold_left
86
+
(fun acc (name, value) -> f Jsont.Meta.none name value acc)
87
+
acc unknown);
88
+
}
89
+
in
83
90
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
84
91
in
85
92
let create_obj url mime_type title size_in_bytes duration_in_seconds unknown =
86
-
create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ~unknown ()
93
+
create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ~unknown
94
+
()
87
95
in
88
96
Jsont.Object.map ~kind ~doc create_obj
89
97
|> Jsont.Object.mem "url" Jsont.string ~enc:url
90
98
|> Jsont.Object.mem "mime_type" Jsont.string ~enc:mime_type
91
99
|> Jsont.Object.opt_mem "title" Jsont.string ~enc:title
92
100
|> Jsont.Object.opt_mem "size_in_bytes" Jsont.int64 ~enc:size_in_bytes
93
-
|> Jsont.Object.opt_mem "duration_in_seconds" Jsont.int ~enc:duration_in_seconds
101
+
|> Jsont.Object.opt_mem "duration_in_seconds" Jsont.int
102
+
~enc:duration_in_seconds
94
103
|> Jsont.Object.keep_unknown unknown_mems ~enc:unknown
95
104
|> Jsont.Object.finish
+25
-30
lib/attachment.mli
+25
-30
lib/attachment.mli
···
5
5
6
6
(** Attachments for JSON Feed items.
7
7
8
-
An attachment represents an external resource related to a feed item,
9
-
such as audio files for podcasts, video files, or other downloadable content.
10
-
Attachments with identical titles indicate alternate formats of the same resource.
8
+
An attachment represents an external resource related to a feed item, such
9
+
as audio files for podcasts, video files, or other downloadable content.
10
+
Attachments with identical titles indicate alternate formats of the same
11
+
resource.
11
12
12
13
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
13
14
14
-
15
-
(** The type representing an attachment. *)
16
15
type t
17
-
16
+
(** The type representing an attachment. *)
18
17
19
18
(** {1 Unknown Fields} *)
20
19
21
20
module Unknown : sig
22
21
type t = (string * Jsont.json) list
23
-
(** Unknown/unrecognized JSON object members.
24
-
Useful for preserving fields from custom extensions or future spec versions. *)
22
+
(** Unknown/unrecognized JSON object members. Useful for preserving fields
23
+
from custom extensions or future spec versions. *)
25
24
26
25
val empty : t
27
26
(** [empty] is the empty list of unknown fields. *)
···
30
29
(** [is_empty u] returns [true] if there are no unknown fields. *)
31
30
end
32
31
33
-
34
32
(** {1 Jsont Type} *)
35
33
36
34
val jsont : t Jsont.t
37
35
(** Declarative JSON type for attachments.
38
36
39
-
Maps JSON objects with "url" (required), "mime_type" (required),
40
-
and optional "title", "size_in_bytes", "duration_in_seconds" fields. *)
41
-
37
+
Maps JSON objects with "url" (required), "mime_type" (required), and
38
+
optional "title", "size_in_bytes", "duration_in_seconds" fields. *)
42
39
43
40
(** {1 Construction} *)
44
41
···
51
48
?unknown:Unknown.t ->
52
49
unit ->
53
50
t
54
-
(** [create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ?unknown ()]
55
-
creates an attachment object.
51
+
(** [create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ?unknown
52
+
()] creates an attachment object.
56
53
57
54
@param url The location of the attachment (required)
58
-
@param mime_type The MIME type of the attachment, e.g. ["audio/mpeg"] (required)
59
-
@param title The name of the attachment; identical titles indicate alternate formats
60
-
of the same resource
55
+
@param mime_type
56
+
The MIME type of the attachment, e.g. ["audio/mpeg"] (required)
57
+
@param title
58
+
The name of the attachment; identical titles indicate alternate formats of
59
+
the same resource
61
60
@param size_in_bytes The size of the attachment file in bytes
62
-
@param duration_in_seconds The duration of the attachment in seconds (for audio/video)
61
+
@param duration_in_seconds
62
+
The duration of the attachment in seconds (for audio/video)
63
63
@param unknown Unknown/custom fields for extensions (default: empty)
64
64
65
65
{b Examples:}
66
66
{[
67
67
(* Simple attachment *)
68
-
let att = Attachment.create
69
-
~url:"https://example.com/episode.mp3"
70
-
~mime_type:"audio/mpeg" ()
68
+
let att =
69
+
Attachment.create ~url:"https://example.com/episode.mp3"
70
+
~mime_type:"audio/mpeg" ()
71
71
72
72
(* Podcast episode with metadata *)
73
-
let att = Attachment.create
74
-
~url:"https://example.com/episode.mp3"
75
-
~mime_type:"audio/mpeg"
76
-
~title:"Episode 42"
77
-
~size_in_bytes:15_728_640L
78
-
~duration_in_seconds:1800 ()
73
+
let att =
74
+
Attachment.create ~url:"https://example.com/episode.mp3"
75
+
~mime_type:"audio/mpeg" ~title:"Episode 42" ~size_in_bytes:15_728_640L
76
+
~duration_in_seconds:1800 ()
79
77
]} *)
80
-
81
78
82
79
(** {1 Accessors} *)
83
80
···
99
96
val unknown : t -> Unknown.t
100
97
(** [unknown t] returns unrecognized fields from the JSON. *)
101
98
102
-
103
99
(** {1 Comparison} *)
104
100
105
101
val equal : t -> t -> bool
106
102
(** [equal a b] tests equality between two attachments. *)
107
-
108
103
109
104
(** {1 Pretty Printing} *)
110
105
+4
-9
lib/cito.ml
+4
-9
lib/cito.ml
···
1
-
type t = [
2
-
| `Cites
1
+
type t =
2
+
[ `Cites
3
3
| `CitesAsAuthority
4
4
| `CitesAsDataSource
5
5
| `CitesAsEvidence
···
47
47
| `SharesPublicationVenueWith
48
48
| `SharesFundingAgencyWith
49
49
| `SharesAuthorInstitutionWith
50
-
| `Other of string
51
-
]
50
+
| `Other of string ]
52
51
53
52
let to_string = function
54
53
| `Cites -> "cites"
···
153
152
| "sharesauthorinstitutionwith" -> `SharesAuthorInstitutionWith
154
153
| _ -> `Other s
155
154
156
-
let equal a b =
157
-
match a, b with
158
-
| `Other sa, `Other sb -> sa = sb
159
-
| _ -> a = b
160
-
155
+
let equal a b = match (a, b) with `Other sa, `Other sb -> sa = sb | _ -> a = b
161
156
let pp ppf t = Format.fprintf ppf "%s" (to_string t)
162
157
163
158
let jsont =
+77
-79
lib/cito.mli
+77
-79
lib/cito.mli
···
1
1
(** Citation Typing Ontology (CiTO) intent annotations.
2
2
3
-
CiTO provides a structured vocabulary for describing the nature of citations.
4
-
This module implements support for CiTO annotations as used in the references extension.
3
+
CiTO provides a structured vocabulary for describing the nature of
4
+
citations. This module implements support for CiTO annotations as used in
5
+
the references extension.
5
6
6
7
@see <https://purl.archive.org/spar/cito> Citation Typing Ontology
7
-
@see <https://sparontologies.github.io/cito/current/cito.html> CiTO Specification *)
8
-
9
-
10
-
(** CiTO citation intent annotation.
11
-
12
-
Represents the intent or nature of a citation using the Citation Typing Ontology.
13
-
Each variant corresponds to a specific CiTO property. The [`Other] variant allows
14
-
for custom or future CiTO terms not yet included in this library.
8
+
@see <https://sparontologies.github.io/cito/current/cito.html>
9
+
CiTO Specification *)
15
10
16
-
{b Categories:}
17
-
- Factual: Citing for data, methods, evidence, or information
18
-
- Critical: Agreement, disagreement, correction, or qualification
19
-
- Rhetorical: Style-based citations (parody, ridicule, etc.)
20
-
- Relational: Document relationships and compilations
21
-
- Support: Providing or obtaining backing and context
22
-
- Exploratory: Speculation and recommendations
23
-
- Quotation: Direct quotes and excerpts
24
-
- Dialogue: Replies and responses
25
-
- Sharing: Common attributes between works *)
26
-
type t = [
27
-
| `Cites (** The base citation property *)
28
-
29
-
(* Factual citation intents *)
30
-
| `CitesAsAuthority (** Cites as authoritative source *)
11
+
type t =
12
+
[ `Cites (** The base citation property *)
13
+
| (* Factual citation intents *)
14
+
`CitesAsAuthority
15
+
(** Cites as authoritative source *)
31
16
| `CitesAsDataSource (** Cites as origin of data *)
32
17
| `CitesAsEvidence (** Cites for factual evidence *)
33
18
| `CitesForInformation (** Cites as information source *)
34
19
| `UsesDataFrom (** Uses data from cited work *)
35
20
| `UsesMethodIn (** Uses methodology from cited work *)
36
21
| `UsesConclusionsFrom (** Applies conclusions from cited work *)
37
-
38
-
(* Agreement/disagreement *)
39
-
| `AgreesWith (** Concurs with cited statements *)
22
+
| (* Agreement/disagreement *)
23
+
`AgreesWith
24
+
(** Concurs with cited statements *)
40
25
| `DisagreesWith (** Rejects cited statements *)
41
26
| `Confirms (** Validates facts in cited work *)
42
27
| `Refutes (** Disproves cited statements *)
43
28
| `Disputes (** Contests without definitive refutation *)
44
-
45
-
(* Critical engagement *)
46
-
| `Critiques (** Analyzes and finds fault *)
29
+
| (* Critical engagement *)
30
+
`Critiques
31
+
(** Analyzes and finds fault *)
47
32
| `Qualifies (** Places conditions on statements *)
48
33
| `Corrects (** Fixes errors in cited work *)
49
34
| `Updates (** Advances understanding beyond cited work *)
50
35
| `Extends (** Builds upon cited facts *)
51
-
52
-
(* Rhetorical/stylistic *)
53
-
| `Parodies (** Imitates for comic effect *)
36
+
| (* Rhetorical/stylistic *)
37
+
`Parodies
38
+
(** Imitates for comic effect *)
54
39
| `Plagiarizes (** Uses without acknowledgment *)
55
40
| `Derides (** Expresses contempt *)
56
41
| `Ridicules (** Mocks cited work *)
57
-
58
-
(* Document relationships *)
59
-
| `Describes (** Characterizes cited entity *)
42
+
| (* Document relationships *)
43
+
`Describes
44
+
(** Characterizes cited entity *)
60
45
| `Documents (** Records information about source *)
61
46
| `CitesAsSourceDocument (** Cites as foundational source *)
62
47
| `CitesAsMetadataDocument (** Cites containing metadata *)
63
48
| `Compiles (** Uses to create new work *)
64
49
| `Reviews (** Examines cited statements *)
65
50
| `Retracts (** Formally withdraws *)
66
-
67
-
(* Support/context *)
68
-
| `Supports (** Provides intellectual backing *)
51
+
| (* Support/context *)
52
+
`Supports
53
+
(** Provides intellectual backing *)
69
54
| `GivesSupportTo (** Provides support to citing entity *)
70
55
| `ObtainsSupportFrom (** Obtains backing from cited work *)
71
56
| `GivesBackgroundTo (** Provides context *)
72
57
| `ObtainsBackgroundFrom (** Obtains context from cited work *)
73
-
74
-
(* Exploratory *)
75
-
| `SpeculatesOn (** Theorizes without firm evidence *)
58
+
| (* Exploratory *)
59
+
`SpeculatesOn
60
+
(** Theorizes without firm evidence *)
76
61
| `CitesAsPotentialSolution (** Offers possible resolution *)
77
62
| `CitesAsRecommendedReading (** Suggests as further reading *)
78
63
| `CitesAsRelated (** Identifies as thematically connected *)
79
-
80
-
(* Quotation/excerpting *)
81
-
| `IncludesQuotationFrom (** Incorporates direct quotes *)
64
+
| (* Quotation/excerpting *)
65
+
`IncludesQuotationFrom
66
+
(** Incorporates direct quotes *)
82
67
| `IncludesExcerptFrom (** Uses non-quoted passages *)
83
-
84
-
(* Dialogue *)
85
-
| `RepliesTo (** Responds to cited statements *)
68
+
| (* Dialogue *)
69
+
`RepliesTo
70
+
(** Responds to cited statements *)
86
71
| `HasReplyFrom (** Evokes response *)
87
-
88
-
(* Linking *)
89
-
| `LinksTo (** Provides URL hyperlink *)
90
-
91
-
(* Shared attribution *)
92
-
| `SharesAuthorWith (** Common authorship *)
72
+
| (* Linking *)
73
+
`LinksTo
74
+
(** Provides URL hyperlink *)
75
+
| (* Shared attribution *)
76
+
`SharesAuthorWith
77
+
(** Common authorship *)
93
78
| `SharesJournalWith (** Published in same journal *)
94
79
| `SharesPublicationVenueWith (** Published in same venue *)
95
80
| `SharesFundingAgencyWith (** Funded by same agency *)
96
81
| `SharesAuthorInstitutionWith (** Authors share affiliation *)
82
+
| (* Extensibility *)
83
+
`Other of string
84
+
(** Custom or future CiTO term *) ]
85
+
(** CiTO citation intent annotation.
97
86
98
-
(* Extensibility *)
99
-
| `Other of string (** Custom or future CiTO term *)
100
-
]
87
+
Represents the intent or nature of a citation using the Citation Typing
88
+
Ontology. Each variant corresponds to a specific CiTO property. The [`Other]
89
+
variant allows for custom or future CiTO terms not yet included in this
90
+
library.
101
91
92
+
{b Categories:}
93
+
- Factual: Citing for data, methods, evidence, or information
94
+
- Critical: Agreement, disagreement, correction, or qualification
95
+
- Rhetorical: Style-based citations (parody, ridicule, etc.)
96
+
- Relational: Document relationships and compilations
97
+
- Support: Providing or obtaining backing and context
98
+
- Exploratory: Speculation and recommendations
99
+
- Quotation: Direct quotes and excerpts
100
+
- Dialogue: Replies and responses
101
+
- Sharing: Common attributes between works *)
102
102
103
103
(** {1 Conversion} *)
104
104
105
+
val of_string : string -> t
105
106
(** [of_string s] converts a CiTO term string to its variant representation.
106
107
107
108
Recognized CiTO terms are converted to their corresponding variants.
108
109
Unrecognized terms are wrapped in [`Other].
109
110
110
-
The comparison is case-insensitive for standard CiTO terms but preserves
111
-
the original case in [`Other] variants.
111
+
The comparison is case-insensitive for standard CiTO terms but preserves the
112
+
original case in [`Other] variants.
112
113
113
114
{b Examples:}
114
115
{[
115
-
of_string "cites" (* returns `Cites *)
116
-
of_string "usesMethodIn" (* returns `UsesMethodIn *)
117
-
of_string "citesAsRecommendedReading" (* returns `CitesAsRecommendedReading *)
118
-
of_string "customTerm" (* returns `Other "customTerm" *)
116
+
of_string "cites" (* returns `Cites *) of_string "usesMethodIn"
117
+
(* returns `UsesMethodIn *) of_string
118
+
"citesAsRecommendedReading" (* returns `CitesAsRecommendedReading *)
119
+
of_string "customTerm" (* returns `Other "customTerm" *)
119
120
]} *)
120
-
val of_string : string -> t
121
121
122
-
(** [to_string t] converts a CiTO variant to its canonical string representation.
122
+
val to_string : t -> string
123
+
(** [to_string t] converts a CiTO variant to its canonical string
124
+
representation.
123
125
124
126
Standard CiTO terms use their official CiTO local names (camelCase).
125
127
[`Other] variants return the wrapped string unchanged.
126
128
127
129
{b Examples:}
128
130
{[
129
-
to_string `Cites (* returns "cites" *)
130
-
to_string `UsesMethodIn (* returns "usesMethodIn" *)
131
-
to_string (`Other "customTerm") (* returns "customTerm" *)
131
+
to_string `Cites (* returns "cites" *) to_string `UsesMethodIn
132
+
(* returns "usesMethodIn" *) to_string (`Other "customTerm")
133
+
(* returns "customTerm" *)
132
134
]} *)
133
-
val to_string : t -> string
134
-
135
135
136
136
(** {1 Comparison} *)
137
137
138
+
val equal : t -> t -> bool
138
139
(** [equal a b] tests equality between two CiTO annotations.
139
140
140
-
Two annotations are equal if they represent the same CiTO term.
141
-
For [`Other] variants, string comparison is case-sensitive. *)
142
-
val equal : t -> t -> bool
143
-
141
+
Two annotations are equal if they represent the same CiTO term. For [`Other]
142
+
variants, string comparison is case-sensitive. *)
144
143
145
144
(** {1 Jsont Type} *)
146
145
147
146
val jsont : t Jsont.t
148
147
(** Declarative JSON type for CiTO annotations.
149
148
150
-
Maps CiTO intent strings to the corresponding variants.
151
-
Unknown intents are mapped to [`Other s]. *)
152
-
149
+
Maps CiTO intent strings to the corresponding variants. Unknown intents are
150
+
mapped to [`Other s]. *)
153
151
154
152
(** {1 Pretty Printing} *)
155
153
154
+
val pp : Format.formatter -> t -> unit
156
155
(** [pp ppf t] pretty prints a CiTO annotation to the formatter.
157
156
158
157
{b Example output:}
159
158
{v citesAsRecommendedReading v} *)
160
-
val pp : Format.formatter -> t -> unit
+21
-22
lib/hub.ml
+21
-22
lib/hub.ml
···
10
10
let is_empty = function [] -> true | _ -> false
11
11
end
12
12
13
-
type t = {
14
-
type_ : string;
15
-
url : string;
16
-
unknown : Unknown.t;
17
-
}
13
+
type t = { type_ : string; url : string; unknown : Unknown.t }
18
14
19
-
let create ~type_ ~url ?(unknown = Unknown.empty) () =
20
-
{ type_; url; unknown }
21
-
15
+
let create ~type_ ~url ?(unknown = Unknown.empty) () = { type_; url; unknown }
22
16
let type_ t = t.type_
23
17
let url t = t.url
24
18
let unknown t = t.unknown
25
-
26
-
let equal a b =
27
-
a.type_ = b.type_ && a.url = b.url
28
-
29
-
let pp ppf t =
30
-
Format.fprintf ppf "%s: %s" t.type_ t.url
19
+
let equal a b = a.type_ = b.type_ && a.url = b.url
20
+
let pp ppf t = Format.fprintf ppf "%s: %s" t.type_ t.url
31
21
32
22
let jsont =
33
23
let kind = "Hub" in
34
24
let doc = "A hub endpoint" in
35
-
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
25
+
let unknown_mems :
26
+
(Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
36
27
let open Jsont.Object.Mems in
37
28
let dec_empty () = [] in
38
29
let dec_add _meta (name : string) value acc =
39
30
((name, Jsont.Meta.none), value) :: acc
40
31
in
41
32
let dec_finish _meta mems =
42
-
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
43
-
let enc = {
44
-
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
45
-
List.fold_left (fun acc (name, value) ->
46
-
f Jsont.Meta.none name value acc
47
-
) acc unknown
48
-
} in
33
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
34
+
in
35
+
let enc =
36
+
{
37
+
enc =
38
+
(fun (type acc)
39
+
(f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc)
40
+
unknown
41
+
(acc : acc)
42
+
->
43
+
List.fold_left
44
+
(fun acc (name, value) -> f Jsont.Meta.none name value acc)
45
+
acc unknown);
46
+
}
47
+
in
49
48
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
50
49
in
51
50
let create_obj type_ url unknown = create ~type_ ~url ~unknown () in
+6
-16
lib/hub.mli
+6
-16
lib/hub.mli
···
11
11
12
12
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
13
13
14
-
15
-
(** The type representing a hub endpoint. *)
16
14
type t
17
-
15
+
(** The type representing a hub endpoint. *)
18
16
19
17
(** {1 Unknown Fields} *)
20
18
21
19
module Unknown : sig
22
20
type t = (string * Jsont.json) list
23
-
(** Unknown/unrecognized JSON object members.
24
-
Useful for preserving fields from custom extensions or future spec versions. *)
21
+
(** Unknown/unrecognized JSON object members. Useful for preserving fields
22
+
from custom extensions or future spec versions. *)
25
23
26
24
val empty : t
27
25
(** [empty] is the empty list of unknown fields. *)
···
29
27
val is_empty : t -> bool
30
28
(** [is_empty u] returns [true] if there are no unknown fields. *)
31
29
end
32
-
33
30
34
31
(** {1 Jsont Type} *)
35
32
···
38
35
39
36
Maps JSON objects with "type" and "url" fields (both required). *)
40
37
41
-
42
38
(** {1 Construction} *)
43
39
44
-
val create :
45
-
type_:string -> url:string ->
46
-
?unknown:Unknown.t -> unit -> t
40
+
val create : type_:string -> url:string -> ?unknown:Unknown.t -> unit -> t
47
41
(** [create ~type_ ~url ?unknown ()] creates a hub object.
48
42
49
43
@param type_ The type of hub protocol (e.g., ["rssCloud"], ["WebSub"])
···
52
46
53
47
{b Example:}
54
48
{[
55
-
let hub = Hub.create
56
-
~type_:"WebSub"
57
-
~url:"https://pubsubhubbub.appspot.com/" ()
49
+
let hub =
50
+
Hub.create ~type_:"WebSub" ~url:"https://pubsubhubbub.appspot.com/" ()
58
51
]} *)
59
-
60
52
61
53
(** {1 Accessors} *)
62
54
···
69
61
val unknown : t -> Unknown.t
70
62
(** [unknown t] returns unrecognized fields from the JSON. *)
71
63
72
-
73
64
(** {1 Comparison} *)
74
65
75
66
val equal : t -> t -> bool
76
67
(** [equal a b] tests equality between two hubs. *)
77
-
78
68
79
69
(** {1 Pretty Printing} *)
80
70
+65
-30
lib/item.ml
+65
-30
lib/item.ml
···
10
10
let is_empty = function [] -> true | _ -> false
11
11
end
12
12
13
-
type content = [
14
-
| `Html of string
15
-
| `Text of string
16
-
| `Both of string * string
17
-
]
13
+
type content = [ `Html of string | `Text of string | `Both of string * string ]
18
14
19
15
type t = {
20
16
id : string;
···
36
32
}
37
33
38
34
let create ~id ~content ?url ?external_url ?title ?summary ?image ?banner_image
39
-
?date_published ?date_modified ?authors ?tags ?language ?attachments ?references
40
-
?(unknown = Unknown.empty) () =
35
+
?date_published ?date_modified ?authors ?tags ?language ?attachments
36
+
?references ?(unknown = Unknown.empty) () =
41
37
{
42
-
id; content; url; external_url; title; summary; image; banner_image;
43
-
date_published; date_modified; authors; tags; language; attachments; references;
38
+
id;
39
+
content;
40
+
url;
41
+
external_url;
42
+
title;
43
+
summary;
44
+
image;
45
+
banner_image;
46
+
date_published;
47
+
date_modified;
48
+
authors;
49
+
tags;
50
+
language;
51
+
attachments;
52
+
references;
44
53
unknown;
45
54
}
46
55
···
76
85
let equal a b = a.id = b.id
77
86
78
87
let compare a b =
79
-
match a.date_published, b.date_published with
88
+
match (a.date_published, b.date_published) with
80
89
| None, None -> 0
81
90
| None, Some _ -> -1
82
91
| Some _, None -> 1
83
92
| Some da, Some db -> Ptime.compare da db
84
93
85
94
let pp ppf t =
86
-
match t.date_published, t.title with
95
+
match (t.date_published, t.title) with
87
96
| Some date, Some title ->
88
97
let (y, m, d), _ = Ptime.to_date_time date in
89
98
Format.fprintf ppf "[%04d-%02d-%02d] %s (%s)" y m d title t.id
90
99
| Some date, None ->
91
100
let (y, m, d), _ = Ptime.to_date_time date in
92
101
Format.fprintf ppf "[%04d-%02d-%02d] %s" y m d t.id
93
-
| None, Some title ->
94
-
Format.fprintf ppf "%s (%s)" title t.id
95
-
| None, None ->
96
-
Format.fprintf ppf "%s" t.id
102
+
| None, Some title -> Format.fprintf ppf "%s (%s)" title t.id
103
+
| None, None -> Format.fprintf ppf "%s" t.id
97
104
98
105
let pp_summary ppf t =
99
106
match t.title with
···
111
118
image banner_image date_published date_modified authors tags language
112
119
attachments references _extensions unknown =
113
120
(* Determine content from content_html and content_text *)
114
-
let content = match content_html, content_text with
121
+
let content =
122
+
match (content_html, content_text) with
115
123
| Some html, Some text -> `Both (html, text)
116
124
| Some html, None -> `Html html
117
125
| None, Some text -> `Text text
···
119
127
Jsont.Error.msg Jsont.Meta.none
120
128
"Item must have at least one of content_html or content_text"
121
129
in
122
-
{ id; content; url; external_url; title; summary; image; banner_image;
123
-
date_published; date_modified; authors; tags; language; attachments;
124
-
references; unknown }
130
+
{
131
+
id;
132
+
content;
133
+
url;
134
+
external_url;
135
+
title;
136
+
summary;
137
+
image;
138
+
banner_image;
139
+
date_published;
140
+
date_modified;
141
+
authors;
142
+
tags;
143
+
language;
144
+
attachments;
145
+
references;
146
+
unknown;
147
+
}
125
148
in
126
149
127
150
(* Encoders to extract fields from item *)
···
143
166
let enc_references t = t.references in
144
167
let enc_unknown t = t.unknown in
145
168
146
-
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
169
+
let unknown_mems :
170
+
(Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
147
171
let open Jsont.Object.Mems in
148
172
let dec_empty () = [] in
149
173
let dec_add _meta (name : string) value acc =
150
174
((name, Jsont.Meta.none), value) :: acc
151
175
in
152
176
let dec_finish _meta mems =
153
-
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
154
-
let enc = {
155
-
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
156
-
List.fold_left (fun acc (name, value) ->
157
-
158
-
f Jsont.Meta.none name value acc
159
-
) acc unknown
160
-
} in
177
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
178
+
in
179
+
let enc =
180
+
{
181
+
enc =
182
+
(fun (type acc)
183
+
(f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc)
184
+
unknown
185
+
(acc : acc)
186
+
->
187
+
List.fold_left
188
+
(fun acc (name, value) -> f Jsont.Meta.none name value acc)
189
+
acc unknown);
190
+
}
191
+
in
161
192
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
162
193
in
163
194
···
176
207
|> Jsont.Object.opt_mem "authors" (Jsont.list Author.jsont) ~enc:enc_authors
177
208
|> Jsont.Object.opt_mem "tags" (Jsont.list Jsont.string) ~enc:enc_tags
178
209
|> Jsont.Object.opt_mem "language" Jsont.string ~enc:enc_language
179
-
|> Jsont.Object.opt_mem "attachments" (Jsont.list Attachment.jsont) ~enc:enc_attachments
180
-
|> Jsont.Object.opt_mem "_references" (Jsont.list Reference.jsont) ~enc:enc_references
210
+
|> Jsont.Object.opt_mem "attachments"
211
+
(Jsont.list Attachment.jsont)
212
+
~enc:enc_attachments
213
+
|> Jsont.Object.opt_mem "_references"
214
+
(Jsont.list Reference.jsont)
215
+
~enc:enc_references
181
216
|> Jsont.Object.opt_mem "_extensions" Jsont.json_object ~enc:(fun _t -> None)
182
217
|> Jsont.Object.keep_unknown unknown_mems ~enc:enc_unknown
183
218
|> Jsont.Object.finish
+12
-21
lib/item.mli
+12
-21
lib/item.mli
···
5
5
6
6
(** Feed items in a JSON Feed.
7
7
8
-
An item represents a single entry in a feed, such as a blog post, podcast episode,
9
-
or microblog entry. Each item must have a unique identifier and content.
8
+
An item represents a single entry in a feed, such as a blog post, podcast
9
+
episode, or microblog entry. Each item must have a unique identifier and
10
+
content.
10
11
11
12
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
12
13
13
-
14
-
(** The type representing a feed item. *)
15
14
type t
15
+
(** The type representing a feed item. *)
16
16
17
+
type content = [ `Html of string | `Text of string | `Both of string * string ]
17
18
(** Content representation for an item.
18
19
19
-
The JSON Feed specification requires that each item has at least one
20
-
form of content. This type enforces that requirement at compile time.
20
+
The JSON Feed specification requires that each item has at least one form of
21
+
content. This type enforces that requirement at compile time.
21
22
22
23
- [`Html s]: Item has HTML content only
23
24
- [`Text s]: Item has plain text content only
24
25
- [`Both (html, text)]: Item has both HTML and plain text versions *)
25
-
type content = [
26
-
| `Html of string
27
-
| `Text of string
28
-
| `Both of string * string
29
-
]
30
-
31
26
32
27
(** {1 Unknown Fields} *)
33
28
34
29
module Unknown : sig
35
30
type t = (string * Jsont.json) list
36
-
(** Unknown/unrecognized JSON object members.
37
-
Useful for preserving fields from custom extensions or future spec versions. *)
31
+
(** Unknown/unrecognized JSON object members. Useful for preserving fields
32
+
from custom extensions or future spec versions. *)
38
33
39
34
val empty : t
40
35
(** [empty] is the empty list of unknown fields. *)
···
43
38
(** [is_empty u] returns [true] if there are no unknown fields. *)
44
39
end
45
40
46
-
47
41
(** {1 Jsont Type} *)
48
42
49
43
val jsont : t Jsont.t
50
44
(** Declarative JSON type for feed items.
51
45
52
-
Maps JSON objects with "id" (required), content fields, and various optional metadata.
53
-
The content must have at least one of "content_html" or "content_text". *)
54
-
46
+
Maps JSON objects with "id" (required), content fields, and various optional
47
+
metadata. The content must have at least one of "content_html" or
48
+
"content_text". *)
55
49
56
50
(** {1 Construction} *)
57
51
···
74
68
?unknown:Unknown.t ->
75
69
unit ->
76
70
t
77
-
78
71
79
72
(** {1 Accessors} *)
80
73
···
97
90
val references : t -> Reference.t list option
98
91
val unknown : t -> Unknown.t
99
92
100
-
101
93
(** {1 Comparison} *)
102
94
103
95
val equal : t -> t -> bool
104
96
val compare : t -> t -> int
105
-
106
97
107
98
(** {1 Pretty Printing} *)
108
99
+50
-43
lib/jsonfeed.ml
+50
-43
lib/jsonfeed.ml
···
36
36
unknown : Unknown.t;
37
37
}
38
38
39
-
let create ~title ?home_page_url ?feed_url ?description ?user_comment
40
-
?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items
39
+
let create ~title ?home_page_url ?feed_url ?description ?user_comment ?next_url
40
+
?icon ?favicon ?authors ?language ?expired ?hubs ~items
41
41
?(unknown = Unknown.empty) () =
42
42
{
43
43
version = "https://jsonfeed.org/version/1.1";
···
72
72
let hubs t = t.hubs
73
73
let items t = t.items
74
74
let unknown t = t.unknown
75
-
76
-
let equal a b =
77
-
a.title = b.title &&
78
-
a.items = b.items
75
+
let equal a b = a.title = b.title && a.items = b.items
79
76
80
77
let pp ppf t =
81
78
Format.fprintf ppf "Feed: %s (%d items)" t.title (List.length t.items)
···
88
85
let jsont =
89
86
let kind = "JSON Feed" in
90
87
let doc = "A JSON Feed document" in
91
-
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
88
+
let unknown_mems :
89
+
(Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
92
90
let open Jsont.Object.Mems in
93
91
let dec_empty () = [] in
94
92
let dec_add _meta (name : string) value acc =
95
93
((name, Jsont.Meta.none), value) :: acc
96
94
in
97
95
let dec_finish _meta mems =
98
-
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
99
-
let enc = {
100
-
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
101
-
List.fold_left (fun acc (name, value) ->
102
-
103
-
f Jsont.Meta.none name value acc
104
-
) acc unknown
105
-
} in
96
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
97
+
in
98
+
let enc =
99
+
{
100
+
enc =
101
+
(fun (type acc)
102
+
(f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc)
103
+
unknown
104
+
(acc : acc)
105
+
->
106
+
List.fold_left
107
+
(fun acc (name, value) -> f Jsont.Meta.none name value acc)
108
+
acc unknown);
109
+
}
110
+
in
106
111
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
107
112
in
108
113
109
114
(* Helper constructor that sets version automatically *)
110
-
let make_from_json _version title home_page_url feed_url description user_comment
111
-
next_url icon favicon authors language expired hubs items unknown =
115
+
let make_from_json _version title home_page_url feed_url description
116
+
user_comment next_url icon favicon authors language expired hubs items
117
+
unknown =
112
118
{
113
119
version = "https://jsonfeed.org/version/1.1";
114
120
title;
···
160
166
let encode_string ?format ?number_format feed =
161
167
Jsont_bytesrw.encode_string' ?format ?number_format jsont feed
162
168
163
-
let of_string s =
164
-
decode_string s
169
+
let of_string s = decode_string s
165
170
166
-
let to_string ?(minify=false) feed =
171
+
let to_string ?(minify = false) feed =
167
172
let format = if minify then Jsont.Minify else Jsont.Indent in
168
173
encode_string ~format feed
169
174
···
174
179
let add_error msg = errors := msg :: !errors in
175
180
176
181
(* Check required fields *)
177
-
if feed.title = "" then
178
-
add_error "title is required and cannot be empty";
182
+
if feed.title = "" then add_error "title is required and cannot be empty";
179
183
180
184
(* Check items have unique IDs *)
181
185
let ids = List.map Item.id feed.items in
···
185
189
186
190
(* Validate authors *)
187
191
(match feed.authors with
188
-
| Some authors ->
189
-
List.iteri (fun i author ->
190
-
if not (Author.is_valid author) then
191
-
add_error (Printf.sprintf "feed author %d is invalid (needs at least one field)" i)
192
-
) authors
193
-
| None -> ());
192
+
| Some authors ->
193
+
List.iteri
194
+
(fun i author ->
195
+
if not (Author.is_valid author) then
196
+
add_error
197
+
(Printf.sprintf
198
+
"feed author %d is invalid (needs at least one field)" i))
199
+
authors
200
+
| None -> ());
194
201
195
202
(* Validate items *)
196
-
List.iteri (fun i item ->
197
-
if Item.id item = "" then
198
-
add_error (Printf.sprintf "item %d has empty ID" i);
203
+
List.iteri
204
+
(fun i item ->
205
+
if Item.id item = "" then
206
+
add_error (Printf.sprintf "item %d has empty ID" i);
199
207
200
-
(* Validate item authors *)
201
-
(match Item.authors item with
202
-
| Some authors ->
203
-
List.iteri (fun j author ->
204
-
if not (Author.is_valid author) then
205
-
add_error (Printf.sprintf "item %d author %d is invalid" i j)
206
-
) authors
207
-
| None -> ())
208
-
) feed.items;
208
+
(* Validate item authors *)
209
+
match Item.authors item with
210
+
| Some authors ->
211
+
List.iteri
212
+
(fun j author ->
213
+
if not (Author.is_valid author) then
214
+
add_error (Printf.sprintf "item %d author %d is invalid" i j))
215
+
authors
216
+
| None -> ())
217
+
feed.items;
209
218
210
-
match !errors with
211
-
| [] -> Ok ()
212
-
| errs -> Error (List.rev errs)
219
+
match !errors with [] -> Ok () | errs -> Error (List.rev errs)
+29
-22
lib/jsonfeed.mli
+29
-22
lib/jsonfeed.mli
···
7
7
8
8
@see <https://www.jsonfeed.org/version/1.1/> JSON Feed Specification *)
9
9
10
-
11
-
(** The type representing a complete JSON Feed. *)
12
10
type t
13
-
11
+
(** The type representing a complete JSON Feed. *)
14
12
15
13
(** {1 Jsont Type} *)
16
14
17
15
val jsont : t Jsont.t
18
16
(** Declarative JSON type for JSON feeds.
19
17
20
-
Maps the complete JSON Feed 1.1 specification including all required
21
-
and optional fields. *)
18
+
Maps the complete JSON Feed 1.1 specification including all required and
19
+
optional fields. *)
22
20
23
21
module Unknown : sig
24
22
type t = (string * Jsont.json) list
25
-
(** Unknown/unrecognized JSON object members.
26
-
Useful for preserving fields from custom extensions or future spec versions. *)
23
+
(** Unknown/unrecognized JSON object members. Useful for preserving fields
24
+
from custom extensions or future spec versions. *)
27
25
28
26
val empty : t
29
27
(** [empty] is the empty list of unknown fields. *)
···
69
67
(** {1 Encoding and Decoding} *)
70
68
71
69
val decode :
72
-
?layout:bool -> ?locs:bool -> ?file:string ->
73
-
Bytesrw.Bytes.Reader.t -> (t, Jsont.Error.t) result
70
+
?layout:bool ->
71
+
?locs:bool ->
72
+
?file:string ->
73
+
Bytesrw.Bytes.Reader.t ->
74
+
(t, Jsont.Error.t) result
74
75
(** [decode r] decodes a JSON Feed from bytesrw reader [r].
75
76
76
77
@param layout Preserve whitespace for round-tripping (default: false)
···
78
79
@param file Source file name for error reporting *)
79
80
80
81
val decode_string :
81
-
?layout:bool -> ?locs:bool -> ?file:string ->
82
-
string -> (t, Jsont.Error.t) result
82
+
?layout:bool ->
83
+
?locs:bool ->
84
+
?file:string ->
85
+
string ->
86
+
(t, Jsont.Error.t) result
83
87
(** [decode_string s] decodes a JSON Feed from string [s]. *)
84
88
85
89
val encode :
86
-
?format:Jsont.format -> ?number_format:Jsont.number_format ->
87
-
t -> eod:bool -> Bytesrw.Bytes.Writer.t -> (unit, Jsont.Error.t) result
90
+
?format:Jsont.format ->
91
+
?number_format:Jsont.number_format ->
92
+
t ->
93
+
eod:bool ->
94
+
Bytesrw.Bytes.Writer.t ->
95
+
(unit, Jsont.Error.t) result
88
96
(** [encode feed w] encodes [feed] to bytesrw writer [w].
89
97
90
-
@param format Output formatting: [Jsont.Minify] or [Jsont.Indent] (default: Minify)
98
+
@param format
99
+
Output formatting: [Jsont.Minify] or [Jsont.Indent] (default: Minify)
91
100
@param number_format Printf format for numbers (default: "%.16g")
92
101
@param eod Write end-of-data marker *)
93
102
94
103
val encode_string :
95
-
?format:Jsont.format -> ?number_format:Jsont.number_format ->
96
-
t -> (string, Jsont.Error.t) result
104
+
?format:Jsont.format ->
105
+
?number_format:Jsont.number_format ->
106
+
t ->
107
+
(string, Jsont.Error.t) result
97
108
(** [encode_string feed] encodes [feed] to a string. *)
98
-
99
109
100
110
val of_string : string -> (t, Jsont.Error.t) result
101
111
(** Alias for [decode_string] with default options. *)
···
103
113
val to_string : ?minify:bool -> t -> (string, Jsont.Error.t) result
104
114
(** [to_string feed] encodes [feed] to string.
105
115
@param minify Use compact format (true) or indented (false, default) *)
106
-
107
116
108
117
(** {1 Validation} *)
109
118
110
119
val validate : t -> (unit, string list) result
111
-
(** [validate feed] validates the feed structure.
112
-
Checks for unique item IDs, valid content, etc. *)
113
-
120
+
(** [validate feed] validates the feed structure. Checks for unique item IDs,
121
+
valid content, etc. *)
114
122
115
123
(** {1 Comparison} *)
116
124
117
125
val equal : t -> t -> bool
118
126
(** [equal a b] tests equality between two feeds. *)
119
-
120
127
121
128
(** {1 Pretty Printing} *)
122
129
+18
-13
lib/reference.ml
+18
-13
lib/reference.ml
···
24
24
let doi t = t.doi
25
25
let cito t = t.cito
26
26
let unknown t = t.unknown
27
-
28
27
let equal a b = String.equal a.url b.url
29
28
30
29
let pp ppf t =
31
30
let open Format in
32
31
fprintf ppf "%s" t.url;
33
-
match t.doi with
34
-
| Some d -> fprintf ppf " [DOI: %s]" d
35
-
| None -> ()
32
+
match t.doi with Some d -> fprintf ppf " [DOI: %s]" d | None -> ()
36
33
37
34
let jsont =
38
35
let kind = "Reference" in
39
36
let doc = "A reference to a cited source" in
40
-
let unknown_mems : (Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
37
+
let unknown_mems :
38
+
(Unknown.t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map =
41
39
let open Jsont.Object.Mems in
42
40
let dec_empty () = [] in
43
41
let dec_add _meta (name : string) value acc =
44
42
((name, Jsont.Meta.none), value) :: acc
45
43
in
46
44
let dec_finish _meta mems =
47
-
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems in
48
-
let enc = {
49
-
enc = fun (type acc) (f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc) unknown (acc : acc) ->
50
-
List.fold_left (fun acc (name, value) ->
51
-
52
-
f Jsont.Meta.none name value acc
53
-
) acc unknown
54
-
} in
45
+
List.rev_map (fun ((name, _meta), value) -> (name, value)) mems
46
+
in
47
+
let enc =
48
+
{
49
+
enc =
50
+
(fun (type acc)
51
+
(f : Jsont.Meta.t -> string -> Jsont.json -> acc -> acc)
52
+
unknown
53
+
(acc : acc)
54
+
->
55
+
List.fold_left
56
+
(fun acc (name, value) -> f Jsont.Meta.none name value acc)
57
+
acc unknown);
58
+
}
59
+
in
55
60
map ~kind:"Unknown members" Jsont.json ~dec_empty ~dec_add ~dec_finish ~enc
56
61
in
57
62
let create_obj url doi cito unknown = create ~url ?doi ?cito ~unknown () in
+24
-28
lib/reference.mli
+24
-28
lib/reference.mli
···
6
6
(** References extension for JSON Feed items.
7
7
8
8
This implements the references extension that allows items to cite sources.
9
-
Each reference represents a cited resource with optional DOI and CiTO annotations.
9
+
Each reference represents a cited resource with optional DOI and CiTO
10
+
annotations.
10
11
11
-
@see <https://github.com/egonw/JSONFeed-extensions/blob/main/references.md> References Extension Specification
12
+
@see <https://github.com/egonw/JSONFeed-extensions/blob/main/references.md>
13
+
References Extension Specification
12
14
@see <https://purl.archive.org/spar/cito> Citation Typing Ontology *)
13
15
14
-
16
+
type t
15
17
(** The type representing a reference to a cited source. *)
16
-
type t
17
-
18
18
19
19
(** {1 Unknown Fields} *)
20
20
21
21
module Unknown : sig
22
22
type t = (string * Jsont.json) list
23
-
(** Unknown/unrecognized JSON object members.
24
-
Useful for preserving fields from custom extensions or future spec versions. *)
23
+
(** Unknown/unrecognized JSON object members. Useful for preserving fields
24
+
from custom extensions or future spec versions. *)
25
25
26
26
val empty : t
27
27
(** [empty] is the empty list of unknown fields. *)
···
30
30
(** [is_empty u] returns [true] if there are no unknown fields. *)
31
31
end
32
32
33
-
34
33
(** {1 Jsont Type} *)
35
34
36
35
val jsont : t Jsont.t
37
36
(** Declarative JSON type for references.
38
37
39
-
Maps JSON objects with "url" (required) and optional "doi" and "cito" fields. *)
40
-
38
+
Maps JSON objects with "url" (required) and optional "doi" and "cito"
39
+
fields. *)
41
40
42
41
(** {1 Construction} *)
43
42
···
50
49
t
51
50
(** [create ~url ?doi ?cito ?unknown ()] creates a reference.
52
51
53
-
@param url Unique URL for the reference (required).
54
-
A URL based on a persistent unique identifier (like DOI) is recommended.
52
+
@param url
53
+
Unique URL for the reference (required). A URL based on a persistent
54
+
unique identifier (like DOI) is recommended.
55
55
@param doi Digital Object Identifier for the reference
56
56
@param cito Citation Typing Ontology intent annotations
57
57
@param unknown Unknown/custom fields for extensions (default: empty)
···
59
59
{b Examples:}
60
60
{[
61
61
(* Simple reference with just a URL *)
62
-
let ref1 = Reference.create
63
-
~url:"https://doi.org/10.5281/zenodo.16755947"
64
-
()
62
+
let ref1 =
63
+
Reference.create ~url:"https://doi.org/10.5281/zenodo.16755947" ()
65
64
66
65
(* Reference with DOI *)
67
-
let ref2 = Reference.create
68
-
~url:"https://doi.org/10.5281/zenodo.16755947"
69
-
~doi:"10.5281/zenodo.16755947"
70
-
()
66
+
let ref2 =
67
+
Reference.create ~url:"https://doi.org/10.5281/zenodo.16755947"
68
+
~doi:"10.5281/zenodo.16755947" ()
71
69
72
70
(* Reference with CiTO annotations *)
73
-
let ref3 = Reference.create
74
-
~url:"https://doi.org/10.5281/zenodo.16755947"
75
-
~doi:"10.5281/zenodo.16755947"
76
-
~cito:[`CitesAsRecommendedReading; `UsesMethodIn]
77
-
()
71
+
let ref3 =
72
+
Reference.create ~url:"https://doi.org/10.5281/zenodo.16755947"
73
+
~doi:"10.5281/zenodo.16755947"
74
+
~cito:[ `CitesAsRecommendedReading; `UsesMethodIn ]
75
+
()
78
76
]} *)
79
77
80
-
81
78
(** {1 Accessors} *)
82
79
83
80
val url : t -> string
···
92
89
val unknown : t -> Unknown.t
93
90
(** [unknown t] returns unrecognized fields from the JSON. *)
94
91
95
-
96
92
(** {1 Comparison} *)
97
93
98
94
val equal : t -> t -> bool
99
95
(** [equal a b] tests equality between two references.
100
96
101
97
References are considered equal if they have the same URL. *)
102
-
103
98
104
99
(** {1 Pretty Printing} *)
105
100
···
107
102
(** [pp ppf t] pretty prints a reference to the formatter.
108
103
109
104
{b Example output:}
110
-
{v https://doi.org/10.5281/zenodo.16755947 [DOI: 10.5281/zenodo.16755947] v} *)
105
+
{v https://doi.org/10.5281/zenodo.16755947 [DOI: 10.5281/zenodo.16755947] v}
106
+
*)
+8
-10
lib/rfc3339.ml
+8
-10
lib/rfc3339.ml
···
4
4
---------------------------------------------------------------------------*)
5
5
6
6
let parse s =
7
-
match Ptime.of_rfc3339 s with
8
-
| Ok (t, _, _) -> Some t
9
-
| Error _ -> None
7
+
match Ptime.of_rfc3339 s with Ok (t, _, _) -> Some t | Error _ -> None
10
8
11
-
let format t =
12
-
Ptime.to_rfc3339 ~frac_s:6 ~tz_offset_s:0 t
13
-
14
-
let pp ppf t =
15
-
Format.pp_print_string ppf (format t)
9
+
let format t = Ptime.to_rfc3339 ~frac_s:6 ~tz_offset_s:0 t
10
+
let pp ppf t = Format.pp_print_string ppf (format t)
16
11
17
12
let jsont =
18
13
let kind = "RFC 3339 timestamp" in
19
14
let doc = "An RFC 3339 date-time string" in
20
-
let dec s = match parse s with
15
+
let dec s =
16
+
match parse s with
21
17
| Some t -> t
22
-
| None -> Jsont.Error.msgf Jsont.Meta.none "%s: invalid RFC 3339 timestamp: %S" kind s
18
+
| None ->
19
+
Jsont.Error.msgf Jsont.Meta.none "%s: invalid RFC 3339 timestamp: %S"
20
+
kind s
23
21
in
24
22
let enc = format in
25
23
Jsont.map ~kind ~doc ~dec ~enc Jsont.string
+4
-5
lib/rfc3339.mli
+4
-5
lib/rfc3339.mli
···
10
10
11
11
@see <https://www.rfc-editor.org/rfc/rfc3339> RFC 3339 *)
12
12
13
-
14
13
val jsont : Ptime.t Jsont.t
15
14
(** [jsont] is a bidirectional JSON type for RFC 3339 timestamps.
16
15
17
-
On decode: accepts JSON strings in RFC 3339 format (e.g., "2024-11-03T10:30:00Z")
18
-
On encode: produces UTC timestamps with 'Z' suffix
16
+
On decode: accepts JSON strings in RFC 3339 format (e.g.,
17
+
"2024-11-03T10:30:00Z") On encode: produces UTC timestamps with 'Z' suffix
19
18
20
19
{b Example:}
21
20
{[
···
36
35
val format : Ptime.t -> string
37
36
(** [format t] formats a timestamp as RFC 3339.
38
37
39
-
Always uses UTC timezone (Z suffix) and includes fractional seconds
40
-
if the timestamp has sub-second precision.
38
+
Always uses UTC timezone (Z suffix) and includes fractional seconds if the
39
+
timestamp has sub-second precision.
41
40
42
41
{b Example output:} ["2024-11-03T10:30:45.123Z"] *)
43
42
+3
-2
test/dune
+3
-2
test/dune
+204
-159
test/test_jsonfeed.ml
+204
-159
test/test_jsonfeed.ml
···
14
14
let test_author_create_with_url () =
15
15
let author = Author.create ~url:"https://example.com" () in
16
16
Alcotest.(check (option string)) "name" None (Author.name author);
17
-
Alcotest.(check (option string)) "url" (Some "https://example.com") (Author.url author);
17
+
Alcotest.(check (option string))
18
+
"url" (Some "https://example.com") (Author.url author);
18
19
Alcotest.(check bool) "is_valid" true (Author.is_valid author)
19
20
20
21
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
22
+
let author =
23
+
Author.create ~name:"Jane Doe" ~url:"https://example.com"
24
+
~avatar:"https://example.com/avatar.png" ()
25
+
in
26
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);
27
+
Alcotest.(check (option string))
28
+
"url" (Some "https://example.com") (Author.url author);
29
+
Alcotest.(check (option string))
30
+
"avatar" (Some "https://example.com/avatar.png") (Author.avatar author);
29
31
Alcotest.(check bool) "is_valid" true (Author.is_valid author)
30
32
31
33
let test_author_create_no_fields_fails () =
32
34
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
+
(Invalid_argument
36
+
"Author.create: at least one field (name, url, or avatar) must be \
37
+
provided") (fun () -> ignore (Author.create ()))
35
38
36
39
let test_author_equal () =
37
40
let a1 = Author.create ~name:"Jane Doe" () in
···
43
46
let test_author_pp () =
44
47
let author = Author.create ~name:"Jane Doe" ~url:"https://example.com" () in
45
48
let s = Format.asprintf "%a" Author.pp author in
46
-
Alcotest.(check string) "pp with name and url" "Jane Doe <https://example.com>" s
49
+
Alcotest.(check string)
50
+
"pp with name and url" "Jane Doe <https://example.com>" s
47
51
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
-
]
52
+
let author_tests =
53
+
[
54
+
("create with name", `Quick, test_author_create_with_name);
55
+
("create with url", `Quick, test_author_create_with_url);
56
+
("create with all fields", `Quick, test_author_create_with_all_fields);
57
+
("create with no fields fails", `Quick, test_author_create_no_fields_fails);
58
+
("equal", `Quick, test_author_equal);
59
+
("pp", `Quick, test_author_pp);
60
+
]
56
61
57
62
(* Attachment tests *)
58
63
59
64
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
+
let att =
66
+
Attachment.create ~url:"https://example.com/file.mp3"
67
+
~mime_type:"audio/mpeg" ()
68
+
in
69
+
Alcotest.(check string)
70
+
"url" "https://example.com/file.mp3" (Attachment.url att);
65
71
Alcotest.(check string) "mime_type" "audio/mpeg" (Attachment.mime_type att);
66
72
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)
73
+
Alcotest.(check (option int64))
74
+
"size_in_bytes" None
75
+
(Attachment.size_in_bytes att);
76
+
Alcotest.(check (option int))
77
+
"duration_in_seconds" None
78
+
(Attachment.duration_in_seconds att)
69
79
70
80
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);
81
+
let att =
82
+
Attachment.create ~url:"https://example.com/episode.mp3"
83
+
~mime_type:"audio/mpeg" ~title:"Episode 1" ~size_in_bytes:15_728_640L
84
+
~duration_in_seconds:1800 ()
85
+
in
86
+
Alcotest.(check string)
87
+
"url" "https://example.com/episode.mp3" (Attachment.url att);
79
88
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)
89
+
Alcotest.(check (option string))
90
+
"title" (Some "Episode 1") (Attachment.title att);
91
+
Alcotest.(check (option int64))
92
+
"size_in_bytes" (Some 15_728_640L)
93
+
(Attachment.size_in_bytes att);
94
+
Alcotest.(check (option int))
95
+
"duration_in_seconds" (Some 1800)
96
+
(Attachment.duration_in_seconds att)
83
97
84
98
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
99
+
let a1 =
100
+
Attachment.create ~url:"https://example.com/file.mp3"
101
+
~mime_type:"audio/mpeg" ()
102
+
in
103
+
let a2 =
104
+
Attachment.create ~url:"https://example.com/file.mp3"
105
+
~mime_type:"audio/mpeg" ()
106
+
in
107
+
let a3 =
108
+
Attachment.create ~url:"https://example.com/other.mp3"
109
+
~mime_type:"audio/mpeg" ()
110
+
in
97
111
Alcotest.(check bool) "equal same" true (Attachment.equal a1 a2);
98
112
Alcotest.(check bool) "equal different" false (Attachment.equal a1 a3)
99
113
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
-
]
114
+
let attachment_tests =
115
+
[
116
+
("create minimal", `Quick, test_attachment_create_minimal);
117
+
("create complete", `Quick, test_attachment_create_complete);
118
+
("equal", `Quick, test_attachment_equal);
119
+
]
105
120
106
121
(* Hub tests *)
107
122
···
117
132
Alcotest.(check bool) "equal same" true (Hub.equal h1 h2);
118
133
Alcotest.(check bool) "equal different" false (Hub.equal h1 h3)
119
134
120
-
let hub_tests = [
121
-
"create", `Quick, test_hub_create;
122
-
"equal", `Quick, test_hub_equal;
123
-
]
135
+
let hub_tests =
136
+
[ ("create", `Quick, test_hub_create); ("equal", `Quick, test_hub_equal) ]
124
137
125
138
(* Item tests *)
126
139
127
140
let test_item_create_html () =
128
-
let item = Item.create
129
-
~id:"https://example.com/1"
130
-
~content:(`Html "<p>Hello</p>")
131
-
() in
141
+
let item =
142
+
Item.create ~id:"https://example.com/1" ~content:(`Html "<p>Hello</p>") ()
143
+
in
132
144
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);
145
+
Alcotest.(check (option string))
146
+
"content_html" (Some "<p>Hello</p>") (Item.content_html item);
134
147
Alcotest.(check (option string)) "content_text" None (Item.content_text item)
135
148
136
149
let test_item_create_text () =
137
-
let item = Item.create
138
-
~id:"https://example.com/2"
139
-
~content:(`Text "Hello world")
140
-
() in
150
+
let item =
151
+
Item.create ~id:"https://example.com/2" ~content:(`Text "Hello world") ()
152
+
in
141
153
Alcotest.(check string) "id" "https://example.com/2" (Item.id item);
142
154
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)
155
+
Alcotest.(check (option string))
156
+
"content_text" (Some "Hello world") (Item.content_text item)
144
157
145
158
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
159
+
let item =
160
+
Item.create ~id:"https://example.com/3"
161
+
~content:(`Both ("<p>Hello</p>", "Hello"))
162
+
()
163
+
in
150
164
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)
165
+
Alcotest.(check (option string))
166
+
"content_html" (Some "<p>Hello</p>") (Item.content_html item);
167
+
Alcotest.(check (option string))
168
+
"content_text" (Some "Hello") (Item.content_text item)
153
169
154
170
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
171
+
let item =
172
+
Item.create ~id:"https://example.com/4" ~content:(`Html "<p>Test</p>")
173
+
~title:"Test Post" ~url:"https://example.com/posts/4"
174
+
~tags:[ "test"; "example" ] ()
175
+
in
162
176
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)
177
+
Alcotest.(check (option string))
178
+
"url" (Some "https://example.com/posts/4") (Item.url item);
179
+
Alcotest.(check (option (list string)))
180
+
"tags"
181
+
(Some [ "test"; "example" ])
182
+
(Item.tags item)
165
183
166
184
let test_item_equal () =
167
185
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
186
+
let i2 =
187
+
Item.create ~id:"https://example.com/1" ~content:(`Html "<p>test</p>") ()
188
+
in
169
189
let i3 = Item.create ~id:"https://example.com/2" ~content:(`Text "test") () in
170
190
Alcotest.(check bool) "equal same id" true (Item.equal i1 i2);
171
191
Alcotest.(check bool) "equal different id" false (Item.equal i1 i3)
172
192
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
-
]
193
+
let item_tests =
194
+
[
195
+
("create with HTML content", `Quick, test_item_create_html);
196
+
("create with text content", `Quick, test_item_create_text);
197
+
("create with both contents", `Quick, test_item_create_both);
198
+
("create with metadata", `Quick, test_item_with_metadata);
199
+
("equal", `Quick, test_item_equal);
200
+
]
180
201
181
202
(* Jsonfeed tests *)
182
203
183
204
let test_feed_create_minimal () =
184
205
let feed = Jsonfeed.create ~title:"Test Feed" ~items:[] () in
185
206
Alcotest.(check string) "title" "Test Feed" (Jsonfeed.title feed);
186
-
Alcotest.(check string) "version" "https://jsonfeed.org/version/1.1" (Jsonfeed.version feed);
207
+
Alcotest.(check string)
208
+
"version" "https://jsonfeed.org/version/1.1" (Jsonfeed.version feed);
187
209
Alcotest.(check int) "items length" 0 (List.length (Jsonfeed.items feed))
188
210
189
211
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
212
+
let item =
213
+
Item.create ~id:"https://example.com/1" ~content:(`Text "Hello") ()
214
+
in
215
+
let feed = Jsonfeed.create ~title:"Test Feed" ~items:[ item ] () in
198
216
Alcotest.(check int) "items length" 1 (List.length (Jsonfeed.items feed))
199
217
200
218
let test_feed_validate_valid () =
···
202
220
match Jsonfeed.validate feed with
203
221
| Ok () -> ()
204
222
| Error errors ->
205
-
Alcotest.fail (Printf.sprintf "Validation should succeed: %s"
206
-
(String.concat "; " errors))
223
+
Alcotest.fail
224
+
(Printf.sprintf "Validation should succeed: %s"
225
+
(String.concat "; " errors))
207
226
208
227
let test_feed_validate_empty_title () =
209
228
let feed = Jsonfeed.create ~title:"" ~items:[] () in
210
229
match Jsonfeed.validate feed with
211
230
| Ok () -> Alcotest.fail "Should fail validation"
212
231
| Error errors ->
213
-
Alcotest.(check bool) "has error" true
232
+
Alcotest.(check bool)
233
+
"has error" true
214
234
(List.exists (fun s -> String.starts_with ~prefix:"title" s) errors)
215
235
216
236
let contains_substring s sub =
···
223
243
let feed = Jsonfeed.create ~title:"Test Feed" ~items:[] () in
224
244
match Jsonfeed.to_string feed with
225
245
| Ok json ->
226
-
Alcotest.(check bool) "contains version" true (contains_substring json "version");
227
-
Alcotest.(check bool) "contains title" true (contains_substring json "Test Feed")
246
+
Alcotest.(check bool)
247
+
"contains version" true
248
+
(contains_substring json "version");
249
+
Alcotest.(check bool)
250
+
"contains title" true
251
+
(contains_substring json "Test Feed")
228
252
| Error e ->
229
-
Alcotest.fail (Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e))
253
+
Alcotest.fail
254
+
(Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e))
230
255
231
256
let test_feed_parse_minimal () =
232
-
let json = {|{
257
+
let json =
258
+
{|{
233
259
"version": "https://jsonfeed.org/version/1.1",
234
260
"title": "Test Feed",
235
261
"items": []
236
-
}|} in
262
+
}|}
263
+
in
237
264
match Jsonfeed.of_string json with
238
265
| Ok feed ->
239
266
Alcotest.(check string) "title" "Test Feed" (Jsonfeed.title feed);
240
267
Alcotest.(check int) "items" 0 (List.length (Jsonfeed.items feed))
241
268
| Error err ->
242
-
Alcotest.fail (Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err))
269
+
Alcotest.fail
270
+
(Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err))
243
271
244
272
let test_feed_parse_with_item () =
245
-
let json = {|{
273
+
let json =
274
+
{|{
246
275
"version": "https://jsonfeed.org/version/1.1",
247
276
"title": "Test Feed",
248
277
"items": [
···
251
280
"content_html": "<p>Hello</p>"
252
281
}
253
282
]
254
-
}|} in
283
+
}|}
284
+
in
255
285
match Jsonfeed.of_string json with
256
-
| Ok feed ->
286
+
| Ok feed -> (
257
287
let items = Jsonfeed.items feed in
258
288
Alcotest.(check int) "items count" 1 (List.length items);
259
-
(match items with
260
-
| [item] ->
261
-
Alcotest.(check string) "item id" "https://example.com/1" (Item.id item);
262
-
Alcotest.(check (option string)) "content_html" (Some "<p>Hello</p>") (Item.content_html item)
263
-
| _ -> Alcotest.fail "Expected 1 item")
289
+
match items with
290
+
| [ item ] ->
291
+
Alcotest.(check string)
292
+
"item id" "https://example.com/1" (Item.id item);
293
+
Alcotest.(check (option string))
294
+
"content_html" (Some "<p>Hello</p>") (Item.content_html item)
295
+
| _ -> Alcotest.fail "Expected 1 item")
264
296
| Error err ->
265
-
Alcotest.fail (Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err))
297
+
Alcotest.fail
298
+
(Printf.sprintf "Parse failed: %s" (Jsont.Error.to_string err))
266
299
267
300
let test_feed_roundtrip () =
268
301
let author = Author.create ~name:"Test Author" () in
269
-
let item = Item.create
270
-
~id:"https://example.com/1"
271
-
~title:"Test Item"
272
-
~content:(`Html "<p>Hello, world!</p>")
273
-
~date_published:(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get)
274
-
~tags:["test"; "example"]
275
-
() in
302
+
let item =
303
+
Item.create ~id:"https://example.com/1" ~title:"Test Item"
304
+
~content:(`Html "<p>Hello, world!</p>")
305
+
~date_published:
306
+
(Jsonfeed.Rfc3339.parse "2024-11-01T10:00:00Z" |> Option.get)
307
+
~tags:[ "test"; "example" ] ()
308
+
in
276
309
277
-
let feed1 = Jsonfeed.create
278
-
~title:"Test Feed"
279
-
~home_page_url:"https://example.com"
280
-
~authors:[author]
281
-
~items:[item]
282
-
() in
310
+
let feed1 =
311
+
Jsonfeed.create ~title:"Test Feed" ~home_page_url:"https://example.com"
312
+
~authors:[ author ] ~items:[ item ] ()
313
+
in
283
314
284
315
(* Serialize and parse *)
285
316
match Jsonfeed.to_string feed1 with
286
317
| Error e ->
287
-
Alcotest.fail (Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e))
288
-
| Ok json ->
318
+
Alcotest.fail
319
+
(Printf.sprintf "Serialization failed: %s" (Jsont.Error.to_string e))
320
+
| Ok json -> (
289
321
match Jsonfeed.of_string json with
290
322
| Ok feed2 ->
291
-
Alcotest.(check string) "title" (Jsonfeed.title feed1) (Jsonfeed.title feed2);
292
-
Alcotest.(check (option string)) "home_page_url"
293
-
(Jsonfeed.home_page_url feed1) (Jsonfeed.home_page_url feed2);
294
-
Alcotest.(check int) "items count"
323
+
Alcotest.(check string)
324
+
"title" (Jsonfeed.title feed1) (Jsonfeed.title feed2);
325
+
Alcotest.(check (option string))
326
+
"home_page_url"
327
+
(Jsonfeed.home_page_url feed1)
328
+
(Jsonfeed.home_page_url feed2);
329
+
Alcotest.(check int)
330
+
"items count"
295
331
(List.length (Jsonfeed.items feed1))
296
332
(List.length (Jsonfeed.items feed2))
297
333
| Error err ->
298
-
Alcotest.fail (Printf.sprintf "Round-trip parse failed: %s" (Jsont.Error.to_string err))
334
+
Alcotest.fail
335
+
(Printf.sprintf "Round-trip parse failed: %s"
336
+
(Jsont.Error.to_string err)))
299
337
300
338
let test_feed_parse_invalid_missing_content () =
301
-
let json = {|{
339
+
let json =
340
+
{|{
302
341
"version": "https://jsonfeed.org/version/1.1",
303
342
"title": "Test",
304
343
"items": [
···
306
345
"id": "1"
307
346
}
308
347
]
309
-
}|} in
348
+
}|}
349
+
in
310
350
match Jsonfeed.of_string json with
311
351
| Ok _ -> Alcotest.fail "Should reject item without content"
312
352
| Error err ->
313
353
let err_str = Jsont.Error.to_string err in
314
-
Alcotest.(check bool) "has error" true
354
+
Alcotest.(check bool)
355
+
"has error" true
315
356
(contains_substring err_str "content")
316
357
317
-
let jsonfeed_tests = [
318
-
"create minimal feed", `Quick, test_feed_create_minimal;
319
-
"create feed with items", `Quick, test_feed_create_with_items;
320
-
"validate valid feed", `Quick, test_feed_validate_valid;
321
-
"validate empty title", `Quick, test_feed_validate_empty_title;
322
-
"to_string", `Quick, test_feed_to_string;
323
-
"parse minimal feed", `Quick, test_feed_parse_minimal;
324
-
"parse feed with item", `Quick, test_feed_parse_with_item;
325
-
"round-trip", `Quick, test_feed_roundtrip;
326
-
"parse invalid missing content", `Quick, test_feed_parse_invalid_missing_content;
327
-
]
358
+
let jsonfeed_tests =
359
+
[
360
+
("create minimal feed", `Quick, test_feed_create_minimal);
361
+
("create feed with items", `Quick, test_feed_create_with_items);
362
+
("validate valid feed", `Quick, test_feed_validate_valid);
363
+
("validate empty title", `Quick, test_feed_validate_empty_title);
364
+
("to_string", `Quick, test_feed_to_string);
365
+
("parse minimal feed", `Quick, test_feed_parse_minimal);
366
+
("parse feed with item", `Quick, test_feed_parse_with_item);
367
+
("round-trip", `Quick, test_feed_roundtrip);
368
+
( "parse invalid missing content",
369
+
`Quick,
370
+
test_feed_parse_invalid_missing_content );
371
+
]
328
372
329
373
(* Main test suite *)
330
374
331
375
let () =
332
-
Alcotest.run "jsonfeed" [
333
-
"Author", author_tests;
334
-
"Attachment", attachment_tests;
335
-
"Hub", hub_tests;
336
-
"Item", item_tests;
337
-
"Jsonfeed", jsonfeed_tests;
338
-
]
376
+
Alcotest.run "jsonfeed"
377
+
[
378
+
("Author", author_tests);
379
+
("Attachment", attachment_tests);
380
+
("Hub", hub_tests);
381
+
("Item", item_tests);
382
+
("Jsonfeed", jsonfeed_tests);
383
+
]
+24
-29
test/test_location_errors.ml
+24
-29
test/test_location_errors.ml
···
11
11
12
12
(* Helper to format path context *)
13
13
let format_context (ctx : Jsont.Error.Context.t) =
14
-
if Jsont.Error.Context.is_empty ctx then
15
-
"$"
14
+
if Jsont.Error.Context.is_empty ctx then "$"
16
15
else
17
16
let indices = ctx in
18
17
let rec format_path acc = function
19
18
| [] -> if acc = "" then "$" else "$" ^ acc
20
19
| ((_kinded_sort, _meta), idx) :: rest ->
21
-
let segment = match idx with
20
+
let segment =
21
+
match idx with
22
22
| Jsont.Path.Mem (name, _meta) -> "." ^ name
23
23
| Jsont.Path.Nth (n, _meta) -> "[" ^ string_of_int n ^ "]"
24
24
in
···
32
32
| "title" -> Jsonfeed.title feed
33
33
| "version" -> Jsonfeed.version feed
34
34
| "item_count" -> string_of_int (List.length (Jsonfeed.items feed))
35
-
| "first_item_id" ->
36
-
(match Jsonfeed.items feed with
37
-
| [] -> "(no items)"
38
-
| item :: _ -> Item.id item)
35
+
| "first_item_id" -> (
36
+
match Jsonfeed.items feed with
37
+
| [] -> "(no items)"
38
+
| item :: _ -> Item.id item)
39
39
| _ -> "(unknown field)"
40
40
41
41
(* Escape JSON strings *)
42
42
let escape_json_string s =
43
43
let buf = Buffer.create (String.length s) in
44
-
String.iter (function
45
-
| '"' -> Buffer.add_string buf "\\\""
46
-
| '\\' -> Buffer.add_string buf "\\\\"
47
-
| '\n' -> Buffer.add_string buf "\\n"
48
-
| '\r' -> Buffer.add_string buf "\\r"
49
-
| '\t' -> Buffer.add_string buf "\\t"
50
-
| c when c < ' ' -> Printf.bprintf buf "\\u%04x" (Char.code c)
51
-
| c -> Buffer.add_char buf c
52
-
) s;
44
+
String.iter
45
+
(function
46
+
| '"' -> Buffer.add_string buf "\\\""
47
+
| '\\' -> Buffer.add_string buf "\\\\"
48
+
| '\n' -> Buffer.add_string buf "\\n"
49
+
| '\r' -> Buffer.add_string buf "\\r"
50
+
| '\t' -> Buffer.add_string buf "\\t"
51
+
| c when c < ' ' -> Printf.bprintf buf "\\u%04x" (Char.code c)
52
+
| c -> Buffer.add_char buf c)
53
+
s;
53
54
Buffer.contents buf
54
55
55
56
(* Output success as JSON *)
56
57
let output_success field value =
57
58
Printf.printf {|{"status":"ok","field":"%s","value":"%s"}|}
58
-
(escape_json_string field)
59
-
(escape_json_string value);
59
+
(escape_json_string field) (escape_json_string value);
60
60
print_newline ()
61
61
62
62
(* Output error as JSON *)
···
66
66
let file = Jsont.Textloc.file textloc in
67
67
let first_byte = Jsont.Textloc.first_byte textloc in
68
68
let last_byte = Jsont.Textloc.last_byte textloc in
69
-
let (line_num, line_start_byte) = Jsont.Textloc.first_line textloc in
69
+
let line_num, line_start_byte = Jsont.Textloc.first_line textloc in
70
70
let column = first_byte - line_start_byte + 1 in
71
71
let context = format_context ctx in
72
72
73
-
Printf.printf {|{"status":"error","message":"%s","location":{"file":"%s","line":%d,"column":%d,"byte_start":%d,"byte_end":%d},"context":"%s"}|}
73
+
Printf.printf
74
+
{|{"status":"error","message":"%s","location":{"file":"%s","line":%d,"column":%d,"byte_start":%d,"byte_end":%d},"context":"%s"}|}
74
75
(escape_json_string message)
75
-
(escape_json_string file)
76
-
line_num
77
-
column
78
-
first_byte
79
-
last_byte
76
+
(escape_json_string file) line_num column first_byte last_byte
80
77
(escape_json_string context);
81
78
print_newline ()
82
79
···
87
84
if Array.length Sys.argv < 2 then (
88
85
Printf.eprintf "Usage: %s <file> [field]\n" Sys.argv.(0);
89
86
Printf.eprintf "Fields: title, version, item_count, first_item_id\n";
90
-
exit 1
91
-
);
87
+
exit 1);
92
88
93
89
let file = Sys.argv.(1) in
94
90
let field = if Array.length Sys.argv > 2 then Sys.argv.(2) else "title" in
95
91
96
92
(* Read file *)
97
93
let content =
98
-
try
99
-
In_channel.with_open_text file In_channel.input_all
94
+
try In_channel.with_open_text file In_channel.input_all
100
95
with Sys_error msg ->
101
96
Printf.printf {|{"status":"error","message":"File error: %s"}|}
102
97
(escape_json_string msg);
+10
-12
test/test_serialization.ml
+10
-12
test/test_serialization.ml
···
5
5
let () =
6
6
(* Create a simple feed *)
7
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
8
+
let item =
9
+
Item.create ~id:"https://example.com/1" ~title:"Test Item"
10
+
~content:(`Html "<p>Hello, world!</p>") ()
11
+
in
13
12
14
-
let feed = Jsonfeed.create
15
-
~title:"Test Feed"
16
-
~home_page_url:"https://example.com"
17
-
~authors:[author]
18
-
~items:[item]
19
-
() in
13
+
let feed =
14
+
Jsonfeed.create ~title:"Test Feed" ~home_page_url:"https://example.com"
15
+
~authors:[ author ] ~items:[ item ] ()
16
+
in
20
17
21
18
(* Serialize to JSON *)
22
-
let json = match Jsonfeed.to_string feed with
19
+
let json =
20
+
match Jsonfeed.to_string feed with
23
21
| Ok s -> s
24
22
| Error e -> failwith (Jsont.Error.to_string e)
25
23
in