My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** River.Cmd - Cmdliner terms for River CLI
2
3 This module provides cmdliner terms that are thin wrappers around
4 the River library functions. All business logic resides in the
5 main River module. *)
6
7open Cmdliner
8
9(* Logging setup *)
10let src = Logs.Src.create "river-cli" ~doc:"River CLI application"
11module Log = (val Logs.src_log src : Logs.LOG)
12
13(* User display formatting *)
14module User_fmt = struct
15 let pp_user_with_handle ppf (handle, fullname) =
16 Fmt.pf ppf "%a (%a)"
17 Fmt.(styled (`Fg `Cyan) string) handle
18 Fmt.(styled `Green string) fullname
19end
20
21(* User management commands - read-only, users managed in Sortal *)
22module User = struct
23 let list state =
24 let users = River.State.list_users state in
25 if users = [] then begin
26 Fmt.pr "@.%a@.@."
27 Fmt.(styled `Yellow string)
28 "No users found. Add contacts with feeds to Sortal to see them here."
29 end else begin
30 Fmt.pr "@.%a@."
31 Fmt.(styled `Bold (styled (`Fg `Cyan) string))
32 (Printf.sprintf "Users (%d total)" (List.length users));
33 Fmt.pr "%a@.@." Fmt.(styled `Faint string) (String.make 60 '-');
34 List.iter (fun username ->
35 match River.State.get_user state ~username with
36 | Some user ->
37 let email_str = match River.User.email user with
38 | Some e -> Fmt.str " %a" Fmt.(styled `Faint string) ("<" ^ e ^ ">")
39 | None -> ""
40 in
41 let feed_count = List.length (River.User.feeds user) in
42 Fmt.pr "%a %a%s@."
43 Fmt.(styled `Bold (styled (`Fg `Blue) string)) username
44 Fmt.(styled `Green string) (River.User.fullname user)
45 email_str;
46 Fmt.pr " %a %a %a@.@."
47 Fmt.(styled `Faint string) "└─"
48 Fmt.(styled (`Fg `Yellow) string) (string_of_int feed_count)
49 Fmt.(styled `Faint string) (if feed_count = 1 then "feed" else "feeds")
50 | None -> ()
51 ) users
52 end;
53 0
54
55 let show state ~username =
56 match River.State.get_user state ~username with
57 | None ->
58 Fmt.pr "@.%a User %a not found@.@."
59 Fmt.(styled (`Fg `Red) string) "✗ Error:"
60 Fmt.(styled `Bold string) username;
61 1
62 | Some user ->
63 Fmt.pr "@.%a@."
64 Fmt.(styled `Bold (styled (`Fg `Cyan) string))
65 (Printf.sprintf "User: %s" (River.User.username user));
66 Fmt.pr "%a@.@." Fmt.(styled `Faint string) (String.make 60 '-');
67
68 Fmt.pr "%a %a@."
69 Fmt.(styled `Faint string) "Full name:"
70 Fmt.(styled `Green string) (River.User.fullname user);
71
72 Fmt.pr "%a %a@."
73 Fmt.(styled `Faint string) "Email: "
74 Fmt.string (Option.value (River.User.email user) ~default:"(not set)");
75
76 Fmt.pr "%a %a@.@."
77 Fmt.(styled `Faint string) "Synced: "
78 Fmt.(styled `Yellow string)
79 (Option.value (River.User.last_synced user) ~default:"never");
80
81 (* Quality analysis *)
82 (match River.State.analyze_user_quality state ~username with
83 | Ok metrics ->
84 let score = River.Quality.quality_score metrics in
85 let total = River.Quality.total_entries metrics in
86 let score_color, score_label = match score with
87 | s when s >= 80.0 -> `Green, "Excellent"
88 | s when s >= 60.0 -> `Yellow, "Good"
89 | s when s >= 40.0 -> `Magenta, "Fair"
90 | _ -> `Red, "Poor"
91 in
92 Fmt.pr "%a %a %.1f/100 %a - %d posts@.@."
93 Fmt.(styled `Faint string) "Quality: "
94 Fmt.(styled (`Fg score_color) string) "●"
95 score
96 Fmt.(styled (`Fg score_color) string) (Printf.sprintf "(%s)" score_label)
97 total
98 | Error _ ->
99 Fmt.pr "%a %a@.@."
100 Fmt.(styled `Faint string) "Quality: "
101 Fmt.(styled `Faint string) "(not synced yet)");
102
103 let feeds = River.User.feeds user in
104 Fmt.pr "%a@."
105 Fmt.(styled `Bold string)
106 (Printf.sprintf "Feeds (%d)" (List.length feeds));
107 Fmt.pr "%a@." Fmt.(styled `Faint string) (String.make 60 '-');
108
109 if feeds = [] then
110 Fmt.pr "%a@.@."
111 Fmt.(styled `Faint string)
112 " No feeds configured for this contact."
113 else
114 List.iter (fun feed ->
115 Fmt.pr "@.%a@."
116 Fmt.(styled `Bold (styled (`Fg `Blue) string))
117 (River.Source.name feed);
118 Fmt.pr " %a %a@.@."
119 Fmt.(styled `Faint string) "URL:"
120 Fmt.(styled (`Fg `Magenta) string) (River.Source.url feed)
121 ) feeds;
122 0
123end
124
125(* Sync command *)
126module Sync = struct
127 let sync_user env state ~username =
128 Fmt.pr "@.%a Syncing feeds for %a...@."
129 Fmt.(styled (`Fg `Cyan) string) "→"
130 Fmt.(styled `Bold string) username;
131 match River.State.sync_user env state ~username with
132 | Ok () ->
133 Fmt.pr "%a Sync completed successfully@.@."
134 Fmt.(styled (`Fg `Green) string) "✓";
135 0
136 | Error err ->
137 Fmt.pr "%a Sync failed: %s@.@."
138 Fmt.(styled (`Fg `Red) string) "✗"
139 err;
140 1
141
142 let sync_all env state =
143 Fmt.pr "@.%a Syncing all users...@.@."
144 Fmt.(styled (`Fg `Cyan) string) "→";
145 match River.State.sync_all env state with
146 | Ok (success, fail) ->
147 if fail = 0 then begin
148 Fmt.pr "%a Successfully synced %a@.@."
149 Fmt.(styled (`Fg `Green) string) "✓"
150 Fmt.(styled `Bold (styled (`Fg `Green) string)) (Printf.sprintf "%d users" success);
151 0
152 end else begin
153 Fmt.pr "%a Synced %a, %a@.@."
154 Fmt.(styled `Yellow string) "⚠"
155 Fmt.(styled (`Fg `Green) string) (Printf.sprintf "%d users" success)
156 Fmt.(styled (`Fg `Red) string) (Printf.sprintf "%d failed" fail);
157 1
158 end
159 | Error err ->
160 Fmt.pr "%a Sync failed: %s@.@."
161 Fmt.(styled (`Fg `Red) string) "✗"
162 err;
163 1
164
165end
166
167(* Post listing commands *)
168module Post = struct
169 let format_date ptime =
170 let open Ptime in
171 let (y, m, d), _ = to_date_time ptime in
172 Printf.sprintf "%02d/%02d/%04d" d m y
173
174 let format_text_construct : Syndic.Atom.text_construct -> string = function
175 | Syndic.Atom.Text s -> s
176 | Syndic.Atom.Html (_, s) -> s
177 | Syndic.Atom.Xhtml (_, _) -> "<xhtml content>"
178
179 let get_content_text (entry : Syndic.Atom.entry) =
180 match entry.content with
181 | Some (Syndic.Atom.Text s) -> Some s
182 | Some (Syndic.Atom.Html (_, s)) -> Some s
183 | Some (Syndic.Atom.Xhtml (_, _)) -> Some "<xhtml content>"
184 | Some (Syndic.Atom.Mime _) -> Some "<mime content>"
185 | Some (Syndic.Atom.Src _) -> Some "<external content>"
186 | None -> None
187
188 let truncate_string s max_len =
189 if String.length s <= max_len then s
190 else String.sub s 0 max_len ^ "..."
191
192 let list state ~username_opt ~limit ~metadata =
193 match username_opt with
194 | Some username ->
195 (* List posts for a specific user *)
196 (match River.State.get_user state ~username with
197 | None ->
198 Log.err (fun m -> m "User %s not found" username);
199 1
200 | Some user ->
201 let entries = River.State.get_user_posts state ~username ?limit () in
202 if entries = [] then begin
203 Fmt.pr "%a@." Fmt.(styled `Yellow string)
204 ("No posts found for user " ^ username);
205 Fmt.pr "%a@." Fmt.(styled `Faint string)
206 ("(Run 'river-cli sync " ^ username ^ "' to fetch posts)");
207 0
208 end else begin
209 Fmt.pr "@.%a@.@."
210 Fmt.(styled `Bold (styled (`Fg `Cyan) string))
211 (Printf.sprintf "Posts for %s (%d total)"
212 (River.User.fullname user) (List.length entries));
213
214 List.iter (fun (entry : Syndic.Atom.entry) ->
215 let entry_id = Uri.to_string entry.id in
216
217 (* Title and ID on separate lines for clarity *)
218 Fmt.pr "%a@."
219 Fmt.(styled `Bold (styled (`Fg `Blue) string))
220 (format_text_construct entry.title);
221 Fmt.pr " %a %a@."
222 Fmt.(styled `Faint string) "ID:"
223 Fmt.(styled (`Fg `Magenta) string) entry_id;
224
225 if metadata then begin
226 (* Show all metadata *)
227 Fmt.pr " %a %a@."
228 Fmt.(styled `Faint string) "Author:"
229 Fmt.(styled `Green string) (River.User.fullname user);
230 Fmt.pr " %a %a@."
231 Fmt.(styled `Faint string) "Updated:"
232 Fmt.(styled `Yellow string) (format_date entry.updated);
233
234 (* Summary if present *)
235 (match entry.summary with
236 | Some summary ->
237 let summary_text = format_text_construct summary in
238 Fmt.pr " %a %a@."
239 Fmt.(styled `Faint string) "Summary:"
240 Fmt.string (truncate_string summary_text 150)
241 | None -> ());
242
243 (* Content (truncated) *)
244 (match get_content_text entry with
245 | Some content ->
246 let clean = Str.global_replace (Str.regexp "<[^>]*>") "" content in
247 let clean = Str.global_replace (Str.regexp "[ \t\n\r]+") " " clean in
248 Fmt.pr " %a %a@."
249 Fmt.(styled `Faint string) "Content:"
250 Fmt.string (truncate_string (String.trim clean) 200)
251 | None -> ());
252
253 (* Links *)
254 (match entry.links with
255 | [] -> ()
256 | links ->
257 Fmt.pr " %a@." Fmt.(styled `Faint string) "Links:";
258 List.iter (fun link ->
259 Fmt.pr " %a@." Fmt.(styled (`Fg `Cyan) string)
260 (Uri.to_string link.Syndic.Atom.href)
261 ) links);
262
263 (* Tags/Categories *)
264 (match entry.categories with
265 | [] -> ()
266 | categories ->
267 Fmt.pr " %a %a@." Fmt.(styled `Faint string) "Tags:"
268 Fmt.(list ~sep:comma (styled (`Fg `Yellow) string))
269 (List.map (fun c -> c.Syndic.Atom.term) categories));
270 end else begin
271 (* Compact view: just author and date *)
272 Fmt.pr " %a %a %a %a@."
273 Fmt.(styled `Faint string) "By"
274 Fmt.(styled `Green string) (River.User.fullname user)
275 Fmt.(styled `Faint string) "on"
276 Fmt.(styled `Yellow string) (format_date entry.updated);
277 end;
278 Fmt.pr "@."
279 ) entries;
280 0
281 end)
282 | None ->
283 (* List posts from all users *)
284 let all_posts = River.State.get_all_posts state ?limit () in
285 if all_posts = [] then begin
286 Fmt.pr "%a@." Fmt.(styled `Yellow string)
287 "No posts found for any users";
288 Fmt.pr "%a@." Fmt.(styled `Faint string)
289 "(Run 'river-cli sync' to fetch posts)";
290 0
291 end else begin
292 Fmt.pr "@.%a@.@."
293 Fmt.(styled `Bold (styled (`Fg `Cyan) string))
294 (Printf.sprintf "Posts from all users (%d total)"
295 (List.length all_posts));
296
297 List.iter (fun (username, entry : string * Syndic.Atom.entry) ->
298 let author_name =
299 match River.State.get_user state ~username with
300 | Some user -> River.User.fullname user
301 | None ->
302 let (author, _) = entry.authors in
303 String.trim author.name
304 in
305 let entry_id = Uri.to_string entry.id in
306
307 (* Title and ID on separate lines for clarity *)
308 Fmt.pr "%a@."
309 Fmt.(styled `Bold (styled (`Fg `Blue) string))
310 (format_text_construct entry.title);
311 Fmt.pr " %a %a@."
312 Fmt.(styled `Faint string) "ID:"
313 Fmt.(styled (`Fg `Magenta) string) entry_id;
314
315 if metadata then begin
316 (* Show all metadata *)
317 Fmt.pr " %a %a@."
318 Fmt.(styled `Faint string) "Author:"
319 Fmt.(styled `Green string) author_name;
320 Fmt.pr " %a %a@."
321 Fmt.(styled `Faint string) "Updated:"
322 Fmt.(styled `Yellow string) (format_date entry.updated);
323
324 (* Summary if present *)
325 (match entry.summary with
326 | Some summary ->
327 let summary_text = format_text_construct summary in
328 Fmt.pr " %a %a@."
329 Fmt.(styled `Faint string) "Summary:"
330 Fmt.string (truncate_string summary_text 150)
331 | None -> ());
332
333 (* Content (truncated) *)
334 (match get_content_text entry with
335 | Some content ->
336 let clean = Str.global_replace (Str.regexp "<[^>]*>") "" content in
337 let clean = Str.global_replace (Str.regexp "[ \t\n\r]+") " " clean in
338 Fmt.pr " %a %a@."
339 Fmt.(styled `Faint string) "Content:"
340 Fmt.string (truncate_string (String.trim clean) 200)
341 | None -> ());
342
343 (* Links *)
344 (match entry.links with
345 | [] -> ()
346 | links ->
347 Fmt.pr " %a@." Fmt.(styled `Faint string) "Links:";
348 List.iter (fun link ->
349 Fmt.pr " %a@." Fmt.(styled (`Fg `Cyan) string)
350 (Uri.to_string link.Syndic.Atom.href)
351 ) links);
352
353 (* Tags/Categories *)
354 (match entry.categories with
355 | [] -> ()
356 | categories ->
357 Fmt.pr " %a %a@." Fmt.(styled `Faint string) "Tags:"
358 Fmt.(list ~sep:comma (styled (`Fg `Yellow) string))
359 (List.map (fun c -> c.Syndic.Atom.term) categories));
360 end else begin
361 (* Compact view: just author and date *)
362 Fmt.pr " %a %a %a %a@."
363 Fmt.(styled `Faint string) "By"
364 Fmt.(styled `Green string) author_name
365 Fmt.(styled `Faint string) "on"
366 Fmt.(styled `Yellow string) (format_date entry.updated);
367 end;
368 Fmt.pr "@."
369 ) all_posts;
370 0
371 end
372
373 let info state ~post_id ~verbose =
374 (* Find the post by ID across all users *)
375 let all_posts = River.State.get_all_posts state () in
376 match List.find_opt (fun (_, entry : string * Syndic.Atom.entry) ->
377 Uri.to_string entry.id = post_id
378 ) all_posts with
379 | None ->
380 Log.err (fun m -> m "Post with ID %s not found" post_id);
381 1
382 | Some (username, entry) ->
383 (* Display post information *)
384 Fmt.pr "@.";
385 Fmt.pr "%a@." Fmt.(styled `Bold string) (String.make 70 '=');
386 Fmt.pr " %a@." Fmt.(styled `Bold (styled (`Fg `Blue) string))
387 (format_text_construct entry.title);
388 Fmt.pr "%a@.@." Fmt.(styled `Bold string) (String.make 70 '=');
389
390 (* Author and date - show handle and full name *)
391 (match River.State.get_user state ~username with
392 | Some user ->
393 Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Author:"
394 User_fmt.pp_user_with_handle (username, River.User.fullname user)
395 | None ->
396 let (author, _) = entry.authors in
397 Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Author:"
398 Fmt.(styled `Green string) (String.trim author.name));
399 Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Published:"
400 Fmt.(styled `Magenta string) (format_date entry.updated);
401 Fmt.pr "%a %a@.@." Fmt.(styled `Cyan string) "ID:"
402 Fmt.(styled `Faint string) post_id;
403
404 (* Summary if present *)
405 (match entry.summary with
406 | Some summary ->
407 Fmt.pr "%a@." Fmt.(styled (`Fg `Yellow) string) "Summary:";
408 Fmt.pr "%s@.@." (format_text_construct summary)
409 | None -> ());
410
411 (* Content *)
412 (match entry.content with
413 | Some content ->
414 let content_str = match content with
415 | Syndic.Atom.Text s -> s
416 | Syndic.Atom.Html (_, s) -> s
417 | Syndic.Atom.Xhtml (_, _) -> "<xhtml content>"
418 | Syndic.Atom.Mime _ -> "<mime content>"
419 | Syndic.Atom.Src _ -> "<external content>"
420 in
421 Fmt.pr "%a@." Fmt.(styled (`Fg `Yellow) string) "Content:";
422 if verbose then begin
423 (* In verbose mode, attempt to convert HTML to markdown *)
424 let markdown = try
425 (* Simple HTML to markdown conversion - just strip tags for now *)
426 let re = Str.regexp "<[^>]*>" in
427 Str.global_replace re "" content_str
428 with _ -> content_str
429 in
430 Fmt.pr "%s@.@." markdown
431 end else begin
432 (* Non-verbose mode: show truncated content *)
433 let max_len = 500 in
434 if String.length content_str > max_len then
435 Fmt.pr "%s...@.@." (String.sub content_str 0 max_len)
436 else
437 Fmt.pr "%s@.@." content_str
438 end
439 | None -> ());
440
441 (* Links *)
442 (match entry.links with
443 | [] -> ()
444 | links ->
445 Fmt.pr "%a@." Fmt.(styled `Cyan string) "Links:";
446 List.iter (fun link ->
447 Fmt.pr " - %s@." (Uri.to_string link.Syndic.Atom.href)
448 ) links;
449 Fmt.pr "@.");
450
451 (* River Categories - always show if any assigned *)
452 let river_category_ids = River.State.get_post_categories state ~post_id in
453 (match river_category_ids with
454 | [] -> ()
455 | cat_ids ->
456 Fmt.pr "%a@." Fmt.(styled `Cyan string) "River Categories:";
457 List.iter (fun cat_id ->
458 match River.State.get_category state ~id:cat_id with
459 | Some cat ->
460 Fmt.pr " - %a (%a)@."
461 Fmt.(styled (`Fg `Green) string) (River.Category.name cat)
462 Fmt.(styled `Faint string) cat_id
463 | None ->
464 Fmt.pr " - %a@." Fmt.(styled `Faint string) cat_id
465 ) cat_ids;
466 Fmt.pr "@.");
467
468 (* Original blog tags if verbose *)
469 if verbose then begin
470 match entry.categories with
471 | [] -> ()
472 | categories ->
473 Fmt.pr "%a@." Fmt.(styled `Cyan string) "Original Blog Tags:";
474 List.iter (fun cat ->
475 Fmt.pr " - %s@." cat.Syndic.Atom.term
476 ) categories;
477 Fmt.pr "@."
478 end;
479
480 0
481end
482
483(* Cmdliner argument definitions *)
484let username_arg =
485 let doc = "Username" in
486 Arg.(required & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)
487
488(* User commands - read-only, users managed in Sortal *)
489let user_list =
490 Term.(const (fun env _xdg _profile ->
491 let state = River.State.create env ~app_name:"river" in
492 User.list state
493 ))
494
495let user_show =
496 Term.(const (fun username env _xdg _profile ->
497 let state = River.State.create env ~app_name:"river" in
498 User.show state ~username
499 ) $ username_arg)
500
501let user_cmd =
502 let doc = "View users from Sortal" in
503 let info = Cmd.info "user" ~doc in
504 let user_list_cmd =
505 Eiocmd.run
506 ~use_keyeio:false
507 ~info:(Cmd.info "list" ~doc:"List all users from Sortal")
508 ~app_name:"river"
509 ~service:"river"
510 user_list
511 in
512 let user_show_cmd =
513 Eiocmd.run
514 ~use_keyeio:false
515 ~info:(Cmd.info "show" ~doc:"Show user details")
516 ~app_name:"river"
517 ~service:"river"
518 user_show
519 in
520 Cmd.group info [
521 user_list_cmd;
522 user_show_cmd;
523 ]
524
525(* Sync command - needs Eio environment for HTTP requests *)
526let sync =
527 let username_opt =
528 let doc = "Sync specific user (omit to sync all)" in
529 Arg.(value & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)
530 in
531 Term.(const (fun username_opt env _xdg _profile ->
532 let state = River.State.create env ~app_name:"river" in
533 match username_opt with
534 | Some username -> Sync.sync_user env state ~username
535 | None -> Sync.sync_all env state
536 ) $ username_opt)
537
538(* List command - doesn't need network, just reads local files *)
539let list =
540 let username_opt_arg =
541 let doc = "Username (optional - defaults to all users)" in
542 Arg.(value & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)
543 in
544 let limit_arg =
545 let doc = "Limit number of posts to display (default: all)" in
546 Arg.(value & opt (some int) None & info ["limit"; "n"] ~doc)
547 in
548 let metadata_arg =
549 let doc = "Show all metadata (author, date, summary, content preview, links, tags)" in
550 Arg.(value & flag & info ["metadata"; "m"] ~doc)
551 in
552 Term.(const (fun username_opt limit metadata env _xdg _profile ->
553 let state = River.State.create env ~app_name:"river" in
554 Post.list state ~username_opt ~limit ~metadata
555 ) $ username_opt_arg $ limit_arg $ metadata_arg)
556
557(* Info command - show detailed post information *)
558let info =
559 let post_id_arg =
560 let doc = "Post ID (URI)" in
561 Arg.(required & pos 0 (some string) None & info [] ~docv:"POST_ID" ~doc)
562 in
563 let full_arg =
564 let doc = "Show full content without truncation" in
565 Arg.(value & flag & info ["full"] ~doc)
566 in
567 Term.(const (fun post_id full env _xdg _profile ->
568 let state = River.State.create env ~app_name:"river" in
569 Post.info state ~post_id ~verbose:full
570 ) $ post_id_arg $ full_arg)
571
572(* Merge command - export merged feed *)
573let merge =
574 let format_arg =
575 let doc = "Output format: atom or jsonfeed" in
576 Arg.(value & opt string "atom" & info ["format"; "f"] ~doc)
577 in
578 let title_arg =
579 let doc = "Feed title" in
580 Arg.(value & opt string "River Merged Feed" & info ["title"; "t"] ~doc)
581 in
582 let limit_arg =
583 let doc = "Maximum number of entries to include (default: all)" in
584 Arg.(value & opt (some int) None & info ["limit"; "n"] ~doc)
585 in
586 Term.(const (fun format title limit env _xdg _profile ->
587 let state = River.State.create env ~app_name:"river" in
588 let format_type = match String.lowercase_ascii format with
589 | "jsonfeed" | "json" -> `Jsonfeed
590 | _ -> `Atom
591 in
592 match River.State.export_merged_feed state ~title ~format:format_type ?limit () with
593 | Ok output ->
594 print_endline output;
595 0
596 | Error err ->
597 Log.err (fun m -> m "Failed to export merged feed: %s" err);
598 1
599 ) $ format_arg $ title_arg $ limit_arg)
600
601let html =
602 let output_dir_arg =
603 let doc = "Output directory for HTML site" in
604 Arg.(required & pos 0 (some string) None & info [] ~docv:"OUTPUT_DIR" ~doc)
605 in
606 let title_arg =
607 let doc = "Site title" in
608 Arg.(value & opt string "River Feed" & info ["title"; "t"] ~doc)
609 in
610 let posts_per_page_arg =
611 let doc = "Number of posts per page (default: 25)" in
612 Arg.(value & opt int 25 & info ["posts-per-page"; "p"] ~doc)
613 in
614 Term.(const (fun output_dir_str title posts_per_page env _xdg _profile ->
615 let state = River.State.create env ~app_name:"river" in
616 let output_dir = Eio.Path.(env#fs / output_dir_str) in
617 match River.State.export_html_site state ~output_dir ~title ~posts_per_page () with
618 | Ok () ->
619 Log.info (fun m -> m "HTML site generated in %s" output_dir_str);
620 0
621 | Error err ->
622 Log.err (fun m -> m "Failed to generate HTML site: %s" err);
623 1
624 ) $ output_dir_arg $ title_arg $ posts_per_page_arg)
625
626(* Category management commands *)
627module Category = struct
628 let list state =
629 let categories = River.State.list_categories state in
630 if categories = [] then begin
631 Fmt.pr "@.%a@.@."
632 Fmt.(styled `Yellow string)
633 "No categories defined yet. Use 'river category add' to create one."
634 end else begin
635 Fmt.pr "@.%a@."
636 Fmt.(styled `Bold (styled (`Fg `Cyan) string))
637 (Printf.sprintf "Categories (%d total)" (List.length categories));
638 Fmt.pr "%a@.@." Fmt.(styled `Faint string) (String.make 60 '-');
639 List.iter (fun cat ->
640 Fmt.pr "%a %a@."
641 Fmt.(styled `Bold (styled (`Fg `Blue) string)) (River.Category.id cat)
642 Fmt.(styled `Green string) (River.Category.name cat);
643 (match River.Category.description cat with
644 | Some desc ->
645 Fmt.pr " %a %a@."
646 Fmt.(styled `Faint string) "└─"
647 Fmt.(styled `Faint string) desc
648 | None -> ());
649 Fmt.pr "@."
650 ) categories
651 end;
652 0
653
654 let add state ~id ~name ?description () =
655 let category = River.Category.create ~id ~name ?description () in
656 match River.State.add_category state category with
657 | Ok () ->
658 Fmt.pr "@.%a Category %a added successfully@.@."
659 Fmt.(styled (`Fg `Green) string) "✓"
660 Fmt.(styled `Bold string) id;
661 0
662 | Error err ->
663 Fmt.pr "@.%a Failed to add category: %s@.@."
664 Fmt.(styled (`Fg `Red) string) "✗"
665 err;
666 1
667
668 let remove state ~id =
669 match River.State.remove_category state ~id with
670 | Ok () ->
671 Fmt.pr "@.%a Category %a removed successfully@.@."
672 Fmt.(styled (`Fg `Green) string) "✓"
673 Fmt.(styled `Bold string) id;
674 0
675 | Error err ->
676 Fmt.pr "@.%a Failed to remove category: %s@.@."
677 Fmt.(styled (`Fg `Red) string) "✗"
678 err;
679 1
680
681 let show state ~id =
682 match River.State.get_category state ~id with
683 | None ->
684 Fmt.pr "@.%a Category %a not found@.@."
685 Fmt.(styled (`Fg `Red) string) "✗ Error:"
686 Fmt.(styled `Bold string) id;
687 1
688 | Some cat ->
689 Fmt.pr "@.%a@."
690 Fmt.(styled `Bold (styled (`Fg `Cyan) string))
691 (Printf.sprintf "Category: %s" (River.Category.id cat));
692 Fmt.pr "%a@.@." Fmt.(styled `Faint string) (String.make 60 '-');
693 Fmt.pr "%a %a@."
694 Fmt.(styled `Faint string) "Name: "
695 Fmt.(styled `Green string) (River.Category.name cat);
696 Fmt.pr "%a %a@.@."
697 Fmt.(styled `Faint string) "Description:"
698 Fmt.string (Option.value (River.Category.description cat) ~default:"(none)");
699
700 let post_ids = River.State.get_posts_by_category state ~category_id:id in
701 Fmt.pr "%a@."
702 Fmt.(styled `Bold string)
703 (Printf.sprintf "Posts (%d)" (List.length post_ids));
704 Fmt.pr "%a@." Fmt.(styled `Faint string) (String.make 60 '-');
705 if post_ids = [] then
706 Fmt.pr "%a@.@."
707 Fmt.(styled `Faint string)
708 " No posts tagged with this category."
709 else begin
710 List.iter (fun post_id ->
711 Fmt.pr " %a %a@."
712 Fmt.(styled `Faint string) "•"
713 Fmt.(styled (`Fg `Blue) string) post_id
714 ) post_ids;
715 Fmt.pr "@."
716 end;
717 0
718end
719
720(* Post category tagging commands *)
721module Post_category = struct
722 let add state ~post_id ~category_id =
723 match River.State.add_post_category state ~post_id ~category_id with
724 | Ok () ->
725 Fmt.pr "@.%a Post %a tagged with category %a@.@."
726 Fmt.(styled (`Fg `Green) string) "✓"
727 Fmt.(styled `Bold string) post_id
728 Fmt.(styled `Bold string) category_id;
729 0
730 | Error err ->
731 Fmt.pr "@.%a Failed to tag post: %s@.@."
732 Fmt.(styled (`Fg `Red) string) "✗"
733 err;
734 1
735
736 let remove state ~post_id ~category_id =
737 match River.State.remove_post_category state ~post_id ~category_id with
738 | Ok () ->
739 Fmt.pr "@.%a Category %a removed from post %a@.@."
740 Fmt.(styled (`Fg `Green) string) "✓"
741 Fmt.(styled `Bold string) category_id
742 Fmt.(styled `Bold string) post_id;
743 0
744 | Error err ->
745 Fmt.pr "@.%a Failed to remove category from post: %s@.@."
746 Fmt.(styled (`Fg `Red) string) "✗"
747 err;
748 1
749
750 let list state ~post_id =
751 let category_ids = River.State.get_post_categories state ~post_id in
752 if category_ids = [] then begin
753 Fmt.pr "@.%a@.@."
754 Fmt.(styled `Yellow string)
755 (Printf.sprintf "Post %s has no categories assigned." post_id)
756 end else begin
757 Fmt.pr "@.%a@."
758 Fmt.(styled `Bold (styled (`Fg `Cyan) string))
759 (Printf.sprintf "Categories for post: %s" post_id);
760 Fmt.pr "%a@.@." Fmt.(styled `Faint string) (String.make 60 '-');
761 List.iter (fun cat_id ->
762 match River.State.get_category state ~id:cat_id with
763 | Some cat ->
764 Fmt.pr "%a %a@.@."
765 Fmt.(styled `Bold (styled (`Fg `Blue) string)) cat_id
766 Fmt.(styled `Green string) (River.Category.name cat)
767 | None ->
768 Fmt.pr "%a %a@.@."
769 Fmt.(styled `Bold (styled (`Fg `Blue) string)) cat_id
770 Fmt.(styled `Faint string) "(category not found)"
771 ) category_ids
772 end;
773 0
774end
775
776(* Cmdliner terms for category commands *)
777let category_list =
778 Term.(const (fun env _xdg _profile ->
779 let state = River.State.create env ~app_name:"river" in
780 Category.list state
781 ))
782
783let category_add =
784 let id_arg = Arg.(required & pos 0 (some string) None & info [] ~docv:"ID" ~doc:"Category ID (e.g., 'ocaml-projects')") in
785 let name_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"NAME" ~doc:"Category display name") in
786 let description_arg = Arg.(value & opt (some string) None & info ["d"; "description"] ~docv:"DESC" ~doc:"Category description") in
787 Term.(const (fun id name description env _xdg _profile ->
788 let state = River.State.create env ~app_name:"river" in
789 Category.add state ~id ~name ?description ()
790 ) $ id_arg $ name_arg $ description_arg)
791
792let category_remove =
793 let id_arg = Arg.(required & pos 0 (some string) None & info [] ~docv:"ID" ~doc:"Category ID to remove") in
794 Term.(const (fun id env _xdg _profile ->
795 let state = River.State.create env ~app_name:"river" in
796 Category.remove state ~id
797 ) $ id_arg)
798
799let category_show =
800 let id_arg = Arg.(required & pos 0 (some string) None & info [] ~docv:"ID" ~doc:"Category ID to show") in
801 Term.(const (fun id env _xdg _profile ->
802 let state = River.State.create env ~app_name:"river" in
803 Category.show state ~id
804 ) $ id_arg)
805
806let category_cmd =
807 let doc = "Manage custom categories" in
808 let info = Cmd.info "category" ~doc in
809 let list_cmd = Eiocmd.run ~use_keyeio:false ~info:(Cmd.info "list" ~doc:"List all categories") ~app_name:"river" ~service:"river" category_list in
810 let add_cmd = Eiocmd.run ~use_keyeio:false ~info:(Cmd.info "add" ~doc:"Add a new category") ~app_name:"river" ~service:"river" category_add in
811 let remove_cmd = Eiocmd.run ~use_keyeio:false ~info:(Cmd.info "remove" ~doc:"Remove a category") ~app_name:"river" ~service:"river" category_remove in
812 let show_cmd = Eiocmd.run ~use_keyeio:false ~info:(Cmd.info "show" ~doc:"Show category details") ~app_name:"river" ~service:"river" category_show in
813 Cmd.group info [list_cmd; add_cmd; remove_cmd; show_cmd]
814
815(* Cmdliner terms for post category tagging commands *)
816let tag_add =
817 let post_id_arg = Arg.(required & pos 0 (some string) None & info [] ~docv:"POST_ID" ~doc:"Post ID to tag") in
818 let category_id_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"CATEGORY_ID" ~doc:"Category ID") in
819 Term.(const (fun post_id category_id env _xdg _profile ->
820 let state = River.State.create env ~app_name:"river" in
821 Post_category.add state ~post_id ~category_id
822 ) $ post_id_arg $ category_id_arg)
823
824let tag_remove =
825 let post_id_arg = Arg.(required & pos 0 (some string) None & info [] ~docv:"POST_ID" ~doc:"Post ID") in
826 let category_id_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"CATEGORY_ID" ~doc:"Category ID to remove") in
827 Term.(const (fun post_id category_id env _xdg _profile ->
828 let state = River.State.create env ~app_name:"river" in
829 Post_category.remove state ~post_id ~category_id
830 ) $ post_id_arg $ category_id_arg)
831
832let tag_list =
833 let post_id_arg = Arg.(required & pos 0 (some string) None & info [] ~docv:"POST_ID" ~doc:"Post ID") in
834 Term.(const (fun post_id env _xdg _profile ->
835 let state = River.State.create env ~app_name:"river" in
836 Post_category.list state ~post_id
837 ) $ post_id_arg)
838
839let tag_cmd =
840 let doc = "Manage post category tags" in
841 let info = Cmd.info "tag" ~doc in
842 let add_cmd = Eiocmd.run ~use_keyeio:false ~info:(Cmd.info "add" ~doc:"Tag a post with a category") ~app_name:"river" ~service:"river" tag_add in
843 let remove_cmd = Eiocmd.run ~use_keyeio:false ~info:(Cmd.info "remove" ~doc:"Remove a category from a post") ~app_name:"river" ~service:"river" tag_remove in
844 let list_cmd = Eiocmd.run ~use_keyeio:false ~info:(Cmd.info "list" ~doc:"List categories for a post") ~app_name:"river" ~service:"river" tag_list in
845 Cmd.group info [add_cmd; remove_cmd; list_cmd]
846
847let main_cmd =
848 let doc = "River feed management CLI" in
849 let main_info = Cmd.info "river-cli" ~version:"1.0" ~doc in
850 let sync_cmd =
851 Eiocmd.run
852 ~use_keyeio:false
853 ~info:(Cmd.info "sync" ~doc:"Sync feeds for users")
854 ~app_name:"river"
855 ~service:"river"
856 sync
857 in
858 let list_cmd =
859 Eiocmd.run
860 ~use_keyeio:false
861 ~info:(Cmd.info "list" ~doc:"List recent posts (from all users by default, or specify a user)")
862 ~app_name:"river"
863 ~service:"river"
864 list
865 in
866 let info_cmd =
867 Eiocmd.run
868 ~use_keyeio:false
869 ~info:(Cmd.info "info" ~doc:"Show detailed post information")
870 ~app_name:"river"
871 ~service:"river"
872 info
873 in
874 let merge_cmd =
875 Eiocmd.run
876 ~use_keyeio:false
877 ~info:(Cmd.info "merge" ~doc:"Export a merged feed combining all users' feeds")
878 ~app_name:"river"
879 ~service:"river"
880 merge
881 in
882 let html_cmd =
883 Eiocmd.run
884 ~use_keyeio:false
885 ~info:(Cmd.info "html" ~doc:"Generate a static HTML site from all feeds")
886 ~app_name:"river"
887 ~service:"river"
888 html
889 in
890 Cmd.group main_info [user_cmd; sync_cmd; list_cmd; info_cmd; merge_cmd; html_cmd; category_cmd; tag_cmd]