this repo has no description
fix
+257
-40
+211
-37
stack/river/bin/river_cli.ml
+211
-37
stack/river/bin/river_cli.ml
···
6
6
type user = {
7
7
username : string;
8
8
fullname : string;
9
-
email : string;
9
+
email : string option;
10
10
feeds : River.source list;
11
11
last_synced : string option;
12
12
}
···
49
49
Some {
50
50
username = json |> member "username" |> to_string;
51
51
fullname = json |> member "fullname" |> to_string;
52
-
email = json |> member "email" |> to_string;
52
+
email = json |> member "email" |> to_string_option;
53
53
feeds;
54
54
last_synced = json |> member "last_synced" |> to_string_option;
55
55
}
···
77
77
`Assoc [
78
78
"username", `String user.username;
79
79
"fullname", `String user.fullname;
80
-
"email", `String user.email;
80
+
"email", (match user.email with
81
+
| Some e -> `String e
82
+
| None -> `Null);
81
83
"feeds", `List feeds_json;
82
84
"last_synced", (match user.last_synced with
83
85
| Some s -> `String s
···
170
172
let list state =
171
173
let users = State.list_users state in
172
174
if users = [] then
173
-
Log.info (fun m -> m "No users found")
175
+
Printf.printf "No users found\n"
174
176
else begin
175
-
Log.info (fun m -> m "Users:");
177
+
Printf.printf "Users:\n";
176
178
List.iter (fun username ->
177
179
match State.load_user state username with
178
180
| Some user ->
179
-
Log.info (fun m -> m " %s (%s <%s>) - %d feeds"
180
-
username user.fullname user.email (List.length user.feeds))
181
+
let email_str = match user.email with
182
+
| Some e -> " <" ^ e ^ ">"
183
+
| None -> ""
184
+
in
185
+
Printf.printf " %s (%s%s) - %d feeds\n"
186
+
username user.fullname email_str (List.length user.feeds)
181
187
| None -> ()
182
188
) users
183
189
end;
···
225
231
| Some user ->
226
232
Printf.printf "Username: %s\n" user.username;
227
233
Printf.printf "Full name: %s\n" user.fullname;
228
-
Printf.printf "Email: %s\n" user.email;
234
+
Printf.printf "Email: %s\n"
235
+
(Option.value user.email ~default:"(none)");
229
236
Printf.printf "Last synced: %s\n"
230
237
(Option.value user.last_synced ~default:"never");
231
238
Printf.printf "Feeds (%d):\n" (List.length user.feeds);
···
238
245
(* Sync command *)
239
246
module Sync = struct
240
247
let merge_entries ~existing ~new_entries =
241
-
(* Create a set of existing entry IDs for deduplication *)
242
-
let module UriSet = Set.Make(Uri) in
243
-
let existing_ids =
248
+
(* Create a map of new entry IDs for efficient lookup and updates *)
249
+
let module UriMap = Map.Make(Uri) in
250
+
let new_entries_map =
244
251
List.fold_left (fun acc (entry : Syndic.Atom.entry) ->
245
-
UriSet.add entry.id acc
246
-
) UriSet.empty existing
252
+
UriMap.add entry.id entry acc
253
+
) UriMap.empty new_entries
247
254
in
248
255
249
-
(* Filter out duplicates from new entries *)
250
-
let unique_new =
251
-
List.filter (fun (entry : Syndic.Atom.entry) ->
252
-
not (UriSet.mem entry.id existing_ids)
253
-
) new_entries
256
+
(* Update existing entries with new ones if IDs match, otherwise keep existing *)
257
+
let updated_existing =
258
+
List.filter_map (fun (entry : Syndic.Atom.entry) ->
259
+
if UriMap.mem entry.id new_entries_map then
260
+
None (* Will be replaced by new entry *)
261
+
else
262
+
Some entry (* Keep existing entry *)
263
+
) existing
254
264
in
255
265
256
-
(* Combine and sort by updated date (newest first) *)
257
-
let combined = unique_new @ existing in
266
+
(* Combine new entries with non-replaced existing entries *)
267
+
let combined = new_entries @ updated_existing in
258
268
List.sort (fun (a : Syndic.Atom.entry) (b : Syndic.Atom.entry) ->
259
269
Ptime.compare b.updated a.updated
260
270
) combined
261
271
262
-
let sync_user ~sw env state ~username =
272
+
let sync_user ~sw ~requests env state ~username =
263
273
match State.load_user state username with
264
274
| None ->
265
275
Log.err (fun m -> m "User %s not found" username);
···
270
280
| Some user ->
271
281
Log.info (fun m -> m "Syncing feeds for user %s..." username);
272
282
273
-
(* Create a single Requests session for all feeds *)
274
-
let requests = Requests.create ~sw env
275
-
~follow_redirects:true
276
-
~max_redirects:5 in
277
-
278
-
(* Fetch all feeds using the shared session and switch *)
283
+
(* Fetch all feeds concurrently using the shared session *)
279
284
let fetched_feeds =
280
-
List.filter_map (fun source ->
285
+
Eio.Fiber.List.filter_map (fun source ->
281
286
try
282
287
Log.info (fun m -> m " Fetching %s (%s)..." source.River.name source.River.url);
283
288
Some (River.fetch ~sw ~requests env source)
···
325
330
0
326
331
end
327
332
328
-
let sync_all ~sw env state =
333
+
let sync_all ~sw ~requests env state =
329
334
let users = State.list_users state in
330
335
if users = [] then begin
331
336
Log.info (fun m -> m "No users to sync");
332
337
0
333
338
end else begin
334
-
Log.info (fun m -> m "Syncing %d users..." (List.length users));
339
+
Log.info (fun m -> m "Syncing %d users concurrently..." (List.length users));
340
+
335
341
let results =
336
-
List.map (fun username ->
337
-
let result = sync_user ~sw env state ~username in
342
+
Eio.Fiber.List.map (fun username ->
343
+
let result = sync_user ~sw ~requests env state ~username in
338
344
Log.debug (fun m -> m "Completed sync for user");
339
345
result
340
346
) users
···
350
356
end
351
357
end
352
358
359
+
(* Post listing commands *)
360
+
module Post = struct
361
+
let format_date ptime =
362
+
let open Ptime in
363
+
let (y, m, d), _ = to_date_time ptime in
364
+
Printf.sprintf "%02d/%02d/%04d" d m y
365
+
366
+
let format_text_construct : Syndic.Atom.text_construct -> string = function
367
+
| Syndic.Atom.Text s -> s
368
+
| Syndic.Atom.Html (_, s) -> s
369
+
| Syndic.Atom.Xhtml (_, _) -> "<xhtml content>"
370
+
371
+
let get_content_length (entry : Syndic.Atom.entry) =
372
+
match entry.content with
373
+
| Some (Syndic.Atom.Text s) -> String.length s
374
+
| Some (Syndic.Atom.Html (_, s)) -> String.length s
375
+
| Some (Syndic.Atom.Xhtml (_, _)) -> 0 (* Could calculate but complex *)
376
+
| Some (Syndic.Atom.Mime _) -> 0
377
+
| Some (Syndic.Atom.Src _) -> 0
378
+
| None -> (
379
+
match entry.summary with
380
+
| Some (Syndic.Atom.Text s) -> String.length s
381
+
| Some (Syndic.Atom.Html (_, s)) -> String.length s
382
+
| Some (Syndic.Atom.Xhtml (_, _)) -> 0
383
+
| None -> 0)
384
+
385
+
let list state ~username_opt ~limit =
386
+
match username_opt with
387
+
| Some username ->
388
+
(* List posts for a specific user *)
389
+
(match State.load_user state username with
390
+
| None ->
391
+
Log.err (fun m -> m "User %s not found" username);
392
+
1
393
+
| Some user ->
394
+
let entries = State.load_existing_posts state username in
395
+
if entries = [] then begin
396
+
Fmt.pr "%a@." Fmt.(styled `Yellow string)
397
+
("No posts found for user " ^ username);
398
+
Fmt.pr "%a@." Fmt.(styled `Faint string)
399
+
("(Run 'river-cli sync " ^ username ^ "' to fetch posts)");
400
+
0
401
+
end else begin
402
+
let to_show = match limit with
403
+
| Some n -> List.filteri (fun i _ -> i < n) entries
404
+
| None -> entries
405
+
in
406
+
Fmt.pr "%a@."
407
+
Fmt.(styled `Bold string)
408
+
(Printf.sprintf "Posts for %s (%d total, showing %d):"
409
+
user.fullname (List.length entries) (List.length to_show));
410
+
411
+
List.iteri (fun i (entry : Syndic.Atom.entry) ->
412
+
(* Use user's full name for all entries *)
413
+
let author_name = user.fullname in
414
+
let content_len = get_content_length entry in
415
+
Fmt.pr "%a %a %a %a %a %a %a %a@."
416
+
Fmt.(styled `Cyan string) (Printf.sprintf "[%d]" (i + 1))
417
+
Fmt.(styled (`Fg `Blue) string) (format_text_construct entry.title)
418
+
Fmt.(styled `Faint string) "-"
419
+
Fmt.(styled `Green string) author_name
420
+
Fmt.(styled `Faint string) "-"
421
+
Fmt.(styled `Magenta string) (format_date entry.updated)
422
+
Fmt.(styled `Faint string) "-"
423
+
Fmt.(styled `Yellow string) (Printf.sprintf "%d chars" content_len)
424
+
) to_show;
425
+
0
426
+
end)
427
+
| None ->
428
+
(* List posts from all users *)
429
+
let users = State.list_users state in
430
+
if users = [] then begin
431
+
Fmt.pr "%a@." Fmt.(styled `Yellow string)
432
+
"No users found";
433
+
Fmt.pr "%a@." Fmt.(styled `Faint string)
434
+
"(Run 'river-cli user add' to create a user)";
435
+
0
436
+
end else begin
437
+
(* Load user data to get full names *)
438
+
let user_map =
439
+
List.fold_left (fun acc username ->
440
+
match State.load_user state username with
441
+
| Some user -> (username, user) :: acc
442
+
| None -> acc
443
+
) [] users
444
+
in
445
+
446
+
(* Collect all entries from all users with username tag *)
447
+
let all_entries =
448
+
List.concat_map (fun username ->
449
+
let entries = State.load_existing_posts state username in
450
+
List.map (fun entry -> (username, entry)) entries
451
+
) users
452
+
in
453
+
454
+
if all_entries = [] then begin
455
+
Fmt.pr "%a@." Fmt.(styled `Yellow string)
456
+
"No posts found for any users";
457
+
Fmt.pr "%a@." Fmt.(styled `Faint string)
458
+
"(Run 'river-cli sync' to fetch posts)";
459
+
0
460
+
end else begin
461
+
(* Sort by date (newest first) *)
462
+
let sorted = List.sort (fun (_, a : string * Syndic.Atom.entry) (_, b) ->
463
+
Ptime.compare b.updated a.updated
464
+
) all_entries in
465
+
466
+
let to_show = match limit with
467
+
| Some n -> List.filteri (fun i _ -> i < n) sorted
468
+
| None -> sorted
469
+
in
470
+
471
+
Fmt.pr "%a@."
472
+
Fmt.(styled `Bold string)
473
+
(Printf.sprintf "Posts from all users (%d total, showing %d):"
474
+
(List.length all_entries) (List.length to_show));
475
+
476
+
List.iteri (fun i (username, entry : string * Syndic.Atom.entry) ->
477
+
(* Use user's full name instead of feed author *)
478
+
let author_name =
479
+
match List.assoc_opt username user_map with
480
+
| Some user -> user.fullname
481
+
| None ->
482
+
(* Fallback to entry author if user not found *)
483
+
let (author, _) = entry.authors in
484
+
String.trim author.name
485
+
in
486
+
let content_len = get_content_length entry in
487
+
Fmt.pr "%a %a %a %a %a %a %a %a@."
488
+
Fmt.(styled `Cyan string) (Printf.sprintf "[%d]" (i + 1))
489
+
Fmt.(styled (`Fg `Blue) string) (format_text_construct entry.title)
490
+
Fmt.(styled `Faint string) "-"
491
+
Fmt.(styled `Green string) author_name
492
+
Fmt.(styled `Faint string) "-"
493
+
Fmt.(styled `Magenta string) (format_date entry.updated)
494
+
Fmt.(styled `Faint string) "-"
495
+
Fmt.(styled `Yellow string) (Printf.sprintf "%d chars" content_len)
496
+
) to_show;
497
+
0
498
+
end
499
+
end
500
+
end
501
+
353
502
(* Cmdliner interface *)
354
503
open Cmdliner
355
504
···
362
511
Arg.(required & opt (some string) None & info ["name"; "n"] ~doc)
363
512
364
513
let email_arg =
365
-
let doc = "Email address of the user" in
366
-
Arg.(required & opt (some string) None & info ["email"; "e"] ~doc)
514
+
let doc = "Email address of the user (optional)" in
515
+
Arg.(value & opt (some string) None & info ["email"; "e"] ~doc)
367
516
368
517
let feed_name_arg =
369
518
let doc = "Feed name/label" in
···
476
625
Logs.info (fun m -> m "Creating switch for sync operations");
477
626
let result = Eio.Switch.run @@ fun sw ->
478
627
Logs.info (fun m -> m "Switch created, running sync");
628
+
629
+
(* Create a single Requests session for all operations *)
630
+
let requests = Requests.create ~sw env
631
+
~follow_redirects:true
632
+
~max_redirects:5 in
633
+
479
634
let res = match username_opt with
480
-
| Some username -> Sync.sync_user ~sw env state ~username
481
-
| None -> Sync.sync_all ~sw env state
635
+
| Some username -> Sync.sync_user ~sw ~requests env state ~username
636
+
| None -> Sync.sync_all ~sw ~requests env state
482
637
in
483
638
Logs.info (fun m -> m "Sync completed, about to exit switch");
484
639
res
···
489
644
let term = Term.(const run $ log_level $ log_style_renderer $ xdg_term $ username_opt) in
490
645
Cmd.v (Cmd.info "sync" ~doc) term
491
646
647
+
let list_cmd fs =
648
+
let doc = "List recent posts (from all users by default, or specify a user)" in
649
+
let xdg_term = Xdge.Cmd.term "river" fs ~config:false ~data:false ~cache:false ~runtime:false () in
650
+
let username_opt_arg =
651
+
let doc = "Username (optional - defaults to all users)" in
652
+
Arg.(value & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)
653
+
in
654
+
let limit_arg =
655
+
let doc = "Limit number of posts to display (default: all)" in
656
+
Arg.(value & opt (some int) None & info ["limit"; "n"] ~doc)
657
+
in
658
+
let run log_level style_renderer (xdg, _cfg) username_opt limit =
659
+
setup_logs style_renderer log_level;
660
+
let state = { xdg } in
661
+
Post.list state ~username_opt ~limit
662
+
in
663
+
let term = Term.(const run $ log_level $ log_style_renderer $ xdg_term $ username_opt_arg $ limit_arg) in
664
+
Cmd.v (Cmd.info "list" ~doc) term
665
+
492
666
let main_cmd fs env =
493
667
let doc = "River feed management CLI" in
494
668
let info = Cmd.info "river-cli" ~version:"1.0" ~doc in
495
-
Cmd.group info [user_cmd fs; sync_cmd fs env]
669
+
Cmd.group info [user_cmd fs; sync_cmd fs env; list_cmd fs]
496
670
497
671
let () =
498
672
(* Initialize the Mirage_crypto RNG for TLS.
+11
-1
stack/river/lib/feed.ml
+11
-1
stack/river/lib/feed.ml
···
32
32
let feed = Atom (Syndic.Atom.parse ~xmlbase (Xmlm.make_input (`String (0, xml)))) in
33
33
Log.debug (fun m -> m "Successfully parsed as Atom feed");
34
34
feed
35
-
with Syndic.Atom.Error.Error (pos, msg) -> (
35
+
with
36
+
| Syndic.Atom.Error.Error (pos, msg) -> (
36
37
Log.debug (fun m -> m "Not an Atom feed: %s at position (%d, %d)"
37
38
msg (fst pos) (snd pos));
38
39
try
···
43
44
Log.err (fun m -> m "Failed to parse as RSS2: %s at position (%d, %d)"
44
45
msg (fst pos) (snd pos));
45
46
failwith "Neither Atom nor RSS2 feed")
47
+
| Not_found as e ->
48
+
Log.err (fun m -> m "Not_found exception during Atom feed parsing");
49
+
Log.err (fun m -> m "Backtrace:\n%s" (Printexc.get_backtrace ()));
50
+
raise e
51
+
| e ->
52
+
Log.err (fun m -> m "Unexpected exception during feed parsing: %s"
53
+
(Printexc.to_string e));
54
+
Log.err (fun m -> m "Backtrace:\n%s" (Printexc.get_backtrace ()));
55
+
raise e
46
56
47
57
let fetch ~sw ?requests env (source : source) =
48
58
Log.info (fun m -> m "Fetching feed '%s' from %s" source.name source.url);
+35
-2
stack/river/lib/post.ml
+35
-2
stack/river/lib/post.ml
···
82
82
***********************************************************************)
83
83
84
84
let post_of_atom ~(feed : Feed.t) (e : Syndic.Atom.entry) =
85
+
Log.debug (fun m -> m "Processing Atom entry: %s"
86
+
(Util.string_of_text_construct e.title));
87
+
85
88
let link =
86
89
try
87
90
Some
88
91
(List.find (fun l -> l.Syndic.Atom.rel = Syndic.Atom.Alternate) e.links)
89
92
.href
90
93
with Not_found -> (
94
+
Log.debug (fun m -> m "No alternate link found, trying fallback");
91
95
match e.links with
92
96
| l :: _ -> Some l.href
93
97
| [] -> (
···
111
115
| Some (Xhtml (xmlbase, h)) -> html_of_syndic ?xmlbase h
112
116
| None -> Soup.parse "")
113
117
in
114
-
let author, _ = e.authors in
118
+
let is_valid_author_name name =
119
+
(* Filter out empty strings and placeholder values like "Unknown" *)
120
+
let trimmed = String.trim name in
121
+
trimmed <> "" && trimmed <> "Unknown"
122
+
in
123
+
let author_name =
124
+
(* Fallback chain for author:
125
+
1. Entry author (if present, not empty, and not "Unknown")
126
+
2. Feed-level author (from Atom feed metadata)
127
+
3. Feed title (from Atom feed metadata)
128
+
4. Source name (manually entered feed name) *)
129
+
try
130
+
let author, _ = e.authors in
131
+
let trimmed = String.trim author.name in
132
+
if is_valid_author_name author.name then trimmed
133
+
else raise Not_found (* Try feed-level author *)
134
+
with Not_found -> (
135
+
match feed.content with
136
+
| Feed.Atom atom_feed -> (
137
+
(* Try feed-level authors *)
138
+
match atom_feed.Syndic.Atom.authors with
139
+
| author :: _ when is_valid_author_name author.name ->
140
+
String.trim author.name
141
+
| _ ->
142
+
(* Use feed title *)
143
+
Util.string_of_text_construct atom_feed.Syndic.Atom.title)
144
+
| Feed.Rss2 _ ->
145
+
(* For RSS2, use the feed name which is the source name *)
146
+
feed.name)
147
+
in
115
148
{
116
149
title = Util.string_of_text_construct e.title;
117
150
link;
118
151
date;
119
152
feed;
120
-
author = author.name;
153
+
author = author_name;
121
154
email = "";
122
155
content;
123
156
link_response = None;