···
feeds : River.source list;
last_synced : string option;
···
username = json |> member "username" |> to_string;
fullname = json |> member "fullname" |> to_string;
+
email = json |> member "email" |> to_string_option;
last_synced = json |> member "last_synced" |> to_string_option;
···
"username", `String user.username;
"fullname", `String user.fullname;
+
"email", (match user.email with
"feeds", `List feeds_json;
"last_synced", (match user.last_synced with
···
let users = State.list_users state in
+
Printf.printf "No users found\n"
+
Printf.printf "Users:\n";
List.iter (fun username ->
match State.load_user state username with
+
let email_str = match user.email with
+
| Some e -> " <" ^ e ^ ">"
+
Printf.printf " %s (%s%s) - %d feeds\n"
+
username user.fullname email_str (List.length user.feeds)
···
Printf.printf "Username: %s\n" user.username;
Printf.printf "Full name: %s\n" user.fullname;
+
Printf.printf "Email: %s\n"
+
(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 =
+
(* Create a map of new entry IDs for efficient lookup and updates *)
+
let module UriMap = Map.Make(Uri) in
List.fold_left (fun acc (entry : Syndic.Atom.entry) ->
+
UriMap.add entry.id entry acc
+
) UriMap.empty new_entries
+
(* Update existing entries with new ones if IDs match, otherwise keep existing *)
+
List.filter_map (fun (entry : Syndic.Atom.entry) ->
+
if UriMap.mem entry.id new_entries_map then
+
None (* Will be replaced by new entry *)
+
Some entry (* Keep existing entry *)
+
(* Combine new entries with non-replaced existing entries *)
+
let combined = new_entries @ updated_existing in
List.sort (fun (a : Syndic.Atom.entry) (b : Syndic.Atom.entry) ->
Ptime.compare b.updated a.updated
+
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);
+
(* Fetch all feeds concurrently using the shared session *)
+
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)
···
+
let sync_all ~sw ~requests env state =
let users = State.list_users state in
Log.info (fun m -> m "No users to sync");
+
Log.info (fun m -> m "Syncing %d users concurrently..." (List.length users));
+
Eio.Fiber.List.map (fun username ->
+
let result = sync_user ~sw ~requests env state ~username in
Log.debug (fun m -> m "Completed sync for user");
···
+
(* Post listing commands *)
+
let format_date ptime =
+
let (y, m, d), _ = to_date_time ptime in
+
Printf.sprintf "%02d/%02d/%04d" d m y
+
let format_text_construct : Syndic.Atom.text_construct -> string = function
+
| Syndic.Atom.Text s -> s
+
| Syndic.Atom.Html (_, s) -> s
+
| Syndic.Atom.Xhtml (_, _) -> "<xhtml content>"
+
let get_content_length (entry : Syndic.Atom.entry) =
+
match entry.content with
+
| Some (Syndic.Atom.Text s) -> String.length s
+
| Some (Syndic.Atom.Html (_, s)) -> String.length s
+
| Some (Syndic.Atom.Xhtml (_, _)) -> 0 (* Could calculate but complex *)
+
| Some (Syndic.Atom.Mime _) -> 0
+
| Some (Syndic.Atom.Src _) -> 0
+
match entry.summary with
+
| Some (Syndic.Atom.Text s) -> String.length s
+
| Some (Syndic.Atom.Html (_, s)) -> String.length s
+
| Some (Syndic.Atom.Xhtml (_, _)) -> 0
+
let list state ~username_opt ~limit =
+
match username_opt with
+
(* List posts for a specific user *)
+
(match State.load_user state username with
+
Log.err (fun m -> m "User %s not found" username);
+
let entries = State.load_existing_posts state username in
+
if entries = [] then begin
+
Fmt.pr "%a@." Fmt.(styled `Yellow string)
+
("No posts found for user " ^ username);
+
Fmt.pr "%a@." Fmt.(styled `Faint string)
+
("(Run 'river-cli sync " ^ username ^ "' to fetch posts)");
+
let to_show = match limit with
+
| Some n -> List.filteri (fun i _ -> i < n) entries
+
Fmt.(styled `Bold string)
+
(Printf.sprintf "Posts for %s (%d total, showing %d):"
+
user.fullname (List.length entries) (List.length to_show));
+
List.iteri (fun i (entry : Syndic.Atom.entry) ->
+
(* Use user's full name for all entries *)
+
let author_name = user.fullname in
+
let content_len = get_content_length entry in
+
Fmt.pr "%a %a %a %a %a %a %a %a@."
+
Fmt.(styled `Cyan string) (Printf.sprintf "[%d]" (i + 1))
+
Fmt.(styled (`Fg `Blue) string) (format_text_construct entry.title)
+
Fmt.(styled `Faint string) "-"
+
Fmt.(styled `Green string) author_name
+
Fmt.(styled `Faint string) "-"
+
Fmt.(styled `Magenta string) (format_date entry.updated)
+
Fmt.(styled `Faint string) "-"
+
Fmt.(styled `Yellow string) (Printf.sprintf "%d chars" content_len)
+
(* List posts from all users *)
+
let users = State.list_users state in
+
if users = [] then begin
+
Fmt.pr "%a@." Fmt.(styled `Yellow string)
+
Fmt.pr "%a@." Fmt.(styled `Faint string)
+
"(Run 'river-cli user add' to create a user)";
+
(* Load user data to get full names *)
+
List.fold_left (fun acc username ->
+
match State.load_user state username with
+
| Some user -> (username, user) :: acc
+
(* Collect all entries from all users with username tag *)
+
List.concat_map (fun username ->
+
let entries = State.load_existing_posts state username in
+
List.map (fun entry -> (username, entry)) entries
+
if all_entries = [] then begin
+
Fmt.pr "%a@." Fmt.(styled `Yellow string)
+
"No posts found for any users";
+
Fmt.pr "%a@." Fmt.(styled `Faint string)
+
"(Run 'river-cli sync' to fetch posts)";
+
(* Sort by date (newest first) *)
+
let sorted = List.sort (fun (_, a : string * Syndic.Atom.entry) (_, b) ->
+
Ptime.compare b.updated a.updated
+
let to_show = match limit with
+
| Some n -> List.filteri (fun i _ -> i < n) sorted
+
Fmt.(styled `Bold string)
+
(Printf.sprintf "Posts from all users (%d total, showing %d):"
+
(List.length all_entries) (List.length to_show));
+
List.iteri (fun i (username, entry : string * Syndic.Atom.entry) ->
+
(* Use user's full name instead of feed author *)
+
match List.assoc_opt username user_map with
+
| Some user -> user.fullname
+
(* Fallback to entry author if user not found *)
+
let (author, _) = entry.authors in
+
String.trim author.name
+
let content_len = get_content_length entry in
+
Fmt.pr "%a %a %a %a %a %a %a %a@."
+
Fmt.(styled `Cyan string) (Printf.sprintf "[%d]" (i + 1))
+
Fmt.(styled (`Fg `Blue) string) (format_text_construct entry.title)
+
Fmt.(styled `Faint string) "-"
+
Fmt.(styled `Green string) author_name
+
Fmt.(styled `Faint string) "-"
+
Fmt.(styled `Magenta string) (format_date entry.updated)
+
Fmt.(styled `Faint string) "-"
+
Fmt.(styled `Yellow string) (Printf.sprintf "%d chars" content_len)
···
Arg.(required & opt (some string) None & info ["name"; "n"] ~doc)
+
let doc = "Email address of the user (optional)" in
+
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");
+
(* Create a single Requests session for all operations *)
+
let requests = Requests.create ~sw env
let res = match username_opt with
+
| Some username -> Sync.sync_user ~sw ~requests env state ~username
+
| 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
+
let doc = "List recent posts (from all users by default, or specify a user)" in
+
let xdg_term = Xdge.Cmd.term "river" fs ~config:false ~data:false ~cache:false ~runtime:false () in
+
let doc = "Username (optional - defaults to all users)" in
+
Arg.(value & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)
+
let doc = "Limit number of posts to display (default: all)" in
+
Arg.(value & opt (some int) None & info ["limit"; "n"] ~doc)
+
let run log_level style_renderer (xdg, _cfg) username_opt limit =
+
setup_logs style_renderer log_level;
+
Post.list state ~username_opt ~limit
+
let term = Term.(const run $ log_level $ log_style_renderer $ xdg_term $ username_opt_arg $ limit_arg) in
+
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
+
Cmd.group info [user_cmd fs; sync_cmd fs env; list_cmd fs]
(* Initialize the Mirage_crypto RNG for TLS.
anil.recoil.org