···
9
+
email : string option;
feeds : River.source list;
last_synced : string option;
···
username = json |> member "username" |> to_string;
fullname = json |> member "fullname" |> to_string;
52
-
email = json |> member "email" |> to_string;
52
+
email = json |> member "email" |> to_string_option;
last_synced = json |> member "last_synced" |> to_string_option;
···
"username", `String user.username;
"fullname", `String user.fullname;
80
-
"email", `String user.email;
80
+
"email", (match user.email with
81
+
| Some e -> `String e
"feeds", `List feeds_json;
"last_synced", (match user.last_synced with
···
let users = State.list_users state in
173
-
Log.info (fun m -> m "No users found")
175
+
Printf.printf "No users found\n"
175
-
Log.info (fun m -> m "Users:");
177
+
Printf.printf "Users:\n";
List.iter (fun username ->
match State.load_user state username with
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 ^ ">"
185
+
Printf.printf " %s (%s%s) - %d feeds\n"
186
+
username user.fullname email_str (List.length user.feeds)
···
Printf.printf "Username: %s\n" user.username;
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)");
Printf.printf "Last synced: %s\n"
(Option.value user.last_synced ~default:"never");
Printf.printf "Feeds (%d):\n" (List.length user.feeds);
···
let merge_entries ~existing ~new_entries =
241
-
(* Create a set of existing entry IDs for deduplication *)
242
-
let module UriSet = Set.Make(Uri) in
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 =
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
249
-
(* Filter out duplicates from new entries *)
251
-
List.filter (fun (entry : Syndic.Atom.entry) ->
252
-
not (UriSet.mem entry.id existing_ids)
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 *)
262
+
Some entry (* Keep existing entry *)
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
List.sort (fun (a : Syndic.Atom.entry) (b : Syndic.Atom.entry) ->
Ptime.compare b.updated a.updated
262
-
let sync_user ~sw env state ~username =
272
+
let sync_user ~sw ~requests env state ~username =
match State.load_user state username with
Log.err (fun m -> m "User %s not found" username);
···
Log.info (fun m -> m "Syncing feeds for user %s..." username);
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
278
-
(* Fetch all feeds using the shared session and switch *)
283
+
(* Fetch all feeds concurrently using the shared session *)
280
-
List.filter_map (fun source ->
285
+
Eio.Fiber.List.filter_map (fun source ->
Log.info (fun m -> m " Fetching %s (%s)..." source.River.name source.River.url);
Some (River.fetch ~sw ~requests env source)
···
328
-
let sync_all ~sw env state =
333
+
let sync_all ~sw ~requests env state =
let users = State.list_users state in
Log.info (fun m -> m "No users to sync");
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));
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
Log.debug (fun m -> m "Completed sync for user");
···
359
+
(* Post listing commands *)
360
+
module Post = struct
361
+
let format_date ptime =
363
+
let (y, m, d), _ = to_date_time ptime in
364
+
Printf.sprintf "%02d/%02d/%04d" d m y
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>"
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
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
385
+
let list state ~username_opt ~limit =
386
+
match username_opt with
388
+
(* List posts for a specific user *)
389
+
(match State.load_user state username with
391
+
Log.err (fun m -> m "User %s not found" username);
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)");
402
+
let to_show = match limit with
403
+
| Some n -> List.filteri (fun i _ -> i < n) entries
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));
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)
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)
433
+
Fmt.pr "%a@." Fmt.(styled `Faint string)
434
+
"(Run 'river-cli user add' to create a user)";
437
+
(* Load user data to get full names *)
439
+
List.fold_left (fun acc username ->
440
+
match State.load_user state username with
441
+
| Some user -> (username, user) :: acc
446
+
(* Collect all entries from all users with username tag *)
448
+
List.concat_map (fun username ->
449
+
let entries = State.load_existing_posts state username in
450
+
List.map (fun entry -> (username, entry)) entries
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)";
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
466
+
let to_show = match limit with
467
+
| Some n -> List.filteri (fun i _ -> i < n) sorted
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));
476
+
List.iteri (fun i (username, entry : string * Syndic.Atom.entry) ->
477
+
(* Use user's full name instead of feed author *)
479
+
match List.assoc_opt username user_map with
480
+
| Some user -> user.fullname
482
+
(* Fallback to entry author if user not found *)
483
+
let (author, _) = entry.authors in
484
+
String.trim author.name
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)
···
Arg.(required & opt (some string) None & info ["name"; "n"] ~doc)
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)
let doc = "Feed name/label" in
···
Logs.info (fun m -> m "Creating switch for sync operations");
let result = Eio.Switch.run @@ fun sw ->
Logs.info (fun m -> m "Switch created, running sync");
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
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
Logs.info (fun m -> m "Sync completed, about to exit switch");
···
let term = Term.(const run $ log_level $ log_style_renderer $ xdg_term $ username_opt) in
Cmd.v (Cmd.info "sync" ~doc) term
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)
655
+
let doc = "Limit number of posts to display (default: all)" in
656
+
Arg.(value & opt (some int) None & info ["limit"; "n"] ~doc)
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
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
let doc = "River feed management CLI" in
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]
(* Initialize the Mirage_crypto RNG for TLS.
anil.recoil.org