this repo has no description
river
+238
-517
+1
-1
stack/river/bin/dune
+1
-1
stack/river/bin/dune
+46
-280
stack/river/cmd/river_cmd.ml
+46
-280
stack/river/cmd/river_cmd.ml
···
10
10
let src = Logs.Src.create "river-cli" ~doc:"River CLI application"
11
11
module Log = (val Logs.src_log src : Logs.LOG)
12
12
13
-
(* User management commands *)
13
+
(* User display formatting *)
14
+
module 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
19
+
end
20
+
21
+
(* User management commands - read-only, users managed in Sortal *)
14
22
module User = struct
15
-
let add state ~username ~fullname ~email =
16
-
let user = River.User.make ~username ~fullname ?email () in
17
-
match River.State.create_user state user with
18
-
| Ok () ->
19
-
Fmt.pr "@.%a %a %a@.@."
20
-
Fmt.(styled (`Fg `Green) string) "✓"
21
-
Fmt.(styled `Bold string) "User created:"
22
-
Fmt.(styled (`Fg `Cyan) string) username;
23
-
0
24
-
| Error err ->
25
-
Fmt.pr "@.%a %s@.@."
26
-
Fmt.(styled (`Fg `Red) string) "✗ Error:"
27
-
err;
28
-
1
29
-
30
-
let remove state ~username =
31
-
match River.State.delete_user state ~username with
32
-
| Ok () ->
33
-
Fmt.pr "@.%a %a %a@.@."
34
-
Fmt.(styled (`Fg `Green) string) "✓"
35
-
Fmt.(styled `Bold string) "User removed:"
36
-
Fmt.(styled (`Fg `Cyan) string) username;
37
-
0
38
-
| Error err ->
39
-
Fmt.pr "@.%a %s@.@."
40
-
Fmt.(styled (`Fg `Red) string) "✗ Error:"
41
-
err;
42
-
1
43
-
44
23
let list state =
45
24
let users = River.State.list_users state in
46
25
if users = [] then begin
47
26
Fmt.pr "@.%a@.@."
48
27
Fmt.(styled `Yellow string)
49
-
"No users found. Use 'river-cli user add' to create one."
28
+
"No users found. Add contacts with feeds to Sortal to see them here."
50
29
end else begin
51
30
Fmt.pr "@.%a@."
52
31
Fmt.(styled `Bold (styled (`Fg `Cyan) string))
···
73
52
end;
74
53
0
75
54
76
-
let add_feed state ~username ~name ~url =
77
-
match River.State.get_user state ~username with
78
-
| None ->
79
-
Fmt.pr "@.%a User %a not found@.@."
80
-
Fmt.(styled (`Fg `Red) string) "✗ Error:"
81
-
Fmt.(styled `Bold string) username;
82
-
1
83
-
| Some user ->
84
-
let source = River.Source.make ~name ~url in
85
-
let user = River.User.add_feed user source in
86
-
(match River.State.update_user state user with
87
-
| Ok () ->
88
-
Fmt.pr "@.%a Feed added to %a@."
89
-
Fmt.(styled (`Fg `Green) string) "✓"
90
-
Fmt.(styled (`Fg `Cyan) string) username;
91
-
Fmt.pr " %a %a@."
92
-
Fmt.(styled `Faint string) "Name:"
93
-
Fmt.(styled `Bold string) name;
94
-
Fmt.pr " %a %a@.@."
95
-
Fmt.(styled `Faint string) "URL: "
96
-
Fmt.(styled (`Fg `Blue) string) url;
97
-
0
98
-
| Error err ->
99
-
Fmt.pr "@.%a %s@.@."
100
-
Fmt.(styled (`Fg `Red) string) "✗ Error:"
101
-
err;
102
-
1)
103
-
104
-
let remove_feed state ~username ~url =
105
-
match River.State.get_user state ~username with
106
-
| None ->
107
-
Fmt.pr "@.%a User %a not found@.@."
108
-
Fmt.(styled (`Fg `Red) string) "✗ Error:"
109
-
Fmt.(styled `Bold string) username;
110
-
1
111
-
| Some user ->
112
-
let user = River.User.remove_feed user ~url in
113
-
(match River.State.update_user state user with
114
-
| Ok () ->
115
-
Fmt.pr "@.%a Feed removed from %a@.@."
116
-
Fmt.(styled (`Fg `Green) string) "✓"
117
-
Fmt.(styled (`Fg `Cyan) string) username;
118
-
0
119
-
| Error err ->
120
-
Fmt.pr "@.%a %s@.@."
121
-
Fmt.(styled (`Fg `Red) string) "✗ Error:"
122
-
err;
123
-
1)
124
-
125
55
let show state ~username =
126
56
match River.State.get_user state ~username with
127
57
| None ->
···
148
78
Fmt.(styled `Yellow string)
149
79
(Option.value (River.User.last_synced user) ~default:"never");
150
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
+
151
103
let feeds = River.User.feeds user in
152
104
Fmt.pr "%a@."
153
105
Fmt.(styled `Bold string)
···
157
109
if feeds = [] then
158
110
Fmt.pr "%a@.@."
159
111
Fmt.(styled `Faint string)
160
-
" No feeds configured. Use 'river-cli user add-feed' to add one."
112
+
" No feeds configured for this contact."
161
113
else
162
114
List.iter (fun feed ->
163
115
Fmt.pr "@.%a@."
···
209
161
Fmt.(styled (`Fg `Red) string) "✗"
210
162
err;
211
163
1
164
+
212
165
end
213
166
214
167
(* Post listing commands *)
···
434
387
(format_text_construct entry.title);
435
388
Fmt.pr "%a@.@." Fmt.(styled `Bold string) (String.make 70 '=');
436
389
437
-
(* Author and date *)
438
-
let author_name =
439
-
match River.State.get_user state ~username with
440
-
| Some user -> River.User.fullname user
441
-
| None ->
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 ->
442
396
let (author, _) = entry.authors in
443
-
String.trim author.name
444
-
in
445
-
Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Author:"
446
-
Fmt.(styled `Green string) author_name;
397
+
Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Author:"
398
+
Fmt.(styled `Green string) (String.trim author.name));
447
399
Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Published:"
448
400
Fmt.(styled `Magenta string) (format_date entry.updated);
449
401
Fmt.pr "%a %a@.@." Fmt.(styled `Cyan string) "ID:"
···
516
468
let doc = "Username" in
517
469
Arg.(required & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)
518
470
519
-
let fullname_arg =
520
-
let doc = "Full name of the user" in
521
-
Arg.(required & opt (some string) None & info ["name"; "n"] ~doc)
522
-
523
-
let email_arg =
524
-
let doc = "Email address of the user (optional)" in
525
-
Arg.(value & opt (some string) None & info ["email"; "e"] ~doc)
526
-
527
-
let feed_name_arg =
528
-
let doc = "Feed name/label" in
529
-
Arg.(required & opt (some string) None & info ["name"; "n"] ~doc)
530
-
531
-
let feed_url_arg =
532
-
let doc = "Feed URL" in
533
-
Arg.(required & opt (some string) None & info ["url"; "u"] ~doc)
534
-
535
-
(* User commands - these don't need network, just filesystem access *)
536
-
let user_add =
537
-
Term.(const (fun username fullname email env _xdg _profile ->
538
-
let state = River.State.create env ~app_name:"river" in
539
-
User.add state ~username ~fullname ~email
540
-
) $ username_arg $ fullname_arg $ email_arg)
541
-
542
-
let user_remove =
543
-
Term.(const (fun username env _xdg _profile ->
544
-
let state = River.State.create env ~app_name:"river" in
545
-
User.remove state ~username
546
-
) $ username_arg)
547
-
471
+
(* User commands - read-only, users managed in Sortal *)
548
472
let user_list =
549
473
Term.(const (fun env _xdg _profile ->
550
474
let state = River.State.create env ~app_name:"river" in
···
557
481
User.show state ~username
558
482
) $ username_arg)
559
483
560
-
let user_add_feed =
561
-
Term.(const (fun username name url env _xdg _profile ->
562
-
let state = River.State.create env ~app_name:"river" in
563
-
User.add_feed state ~username ~name ~url
564
-
) $ username_arg $ feed_name_arg $ feed_url_arg)
565
-
566
-
let user_remove_feed =
567
-
Term.(const (fun username url env _xdg _profile ->
568
-
let state = River.State.create env ~app_name:"river" in
569
-
User.remove_feed state ~username ~url
570
-
) $ username_arg $ feed_url_arg)
571
-
572
484
let user_cmd =
573
-
let doc = "Manage users" in
485
+
let doc = "View users from Sortal" in
574
486
let info = Cmd.info "user" ~doc in
575
-
let user_add_cmd =
576
-
Eiocmd.run
577
-
~use_keyeio:false
578
-
~info:(Cmd.info "add" ~doc:"Add a new user")
579
-
~app_name:"river"
580
-
~service:"river"
581
-
user_add
582
-
in
583
-
let user_remove_cmd =
584
-
Eiocmd.run
585
-
~use_keyeio:false
586
-
~info:(Cmd.info "remove" ~doc:"Remove a user")
587
-
~app_name:"river"
588
-
~service:"river"
589
-
user_remove
590
-
in
591
487
let user_list_cmd =
592
488
Eiocmd.run
593
489
~use_keyeio:false
594
-
~info:(Cmd.info "list" ~doc:"List all users")
490
+
~info:(Cmd.info "list" ~doc:"List all users from Sortal")
595
491
~app_name:"river"
596
492
~service:"river"
597
493
user_list
···
604
500
~service:"river"
605
501
user_show
606
502
in
607
-
let user_add_feed_cmd =
608
-
Eiocmd.run
609
-
~use_keyeio:false
610
-
~info:(Cmd.info "add-feed" ~doc:"Add a feed to a user")
611
-
~app_name:"river"
612
-
~service:"river"
613
-
user_add_feed
614
-
in
615
-
let user_remove_feed_cmd =
616
-
Eiocmd.run
617
-
~use_keyeio:false
618
-
~info:(Cmd.info "remove-feed" ~doc:"Remove a feed from a user")
619
-
~app_name:"river"
620
-
~service:"river"
621
-
user_remove_feed
622
-
in
623
503
Cmd.group info [
624
-
user_add_cmd;
625
-
user_remove_cmd;
626
504
user_list_cmd;
627
505
user_show_cmd;
628
-
user_add_feed_cmd;
629
-
user_remove_feed_cmd;
630
506
]
631
507
632
508
(* Sync command - needs Eio environment for HTTP requests *)
···
704
580
Log.err (fun m -> m "Failed to export merged feed: %s" err);
705
581
1
706
582
) $ format_arg $ title_arg $ limit_arg)
707
-
708
-
(* Quality command - analyze feed quality *)
709
-
let quality =
710
-
let username_arg =
711
-
let doc = "Username to analyze" in
712
-
Arg.(required & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)
713
-
in
714
-
Term.(const (fun username env _xdg _profile ->
715
-
let state = River.State.create env ~app_name:"river" in
716
-
match River.State.analyze_user_quality state ~username with
717
-
| Error err ->
718
-
Log.err (fun m -> m "%s" err);
719
-
1
720
-
| Ok metrics ->
721
-
(* Display quality metrics *)
722
-
Fmt.pr "@.%a@."
723
-
Fmt.(styled `Bold (styled (`Fg `Cyan) string))
724
-
(Printf.sprintf "Feed Quality Analysis: %s" username);
725
-
Fmt.pr "%a@.@." Fmt.(styled `Faint string) (String.make 70 '=');
726
-
727
-
(* Overall quality score with visual indicator *)
728
-
let score = River.Quality.quality_score metrics in
729
-
let score_color, score_label = match score with
730
-
| s when s >= 80.0 -> `Green, "Excellent"
731
-
| s when s >= 60.0 -> `Yellow, "Good"
732
-
| s when s >= 40.0 -> `Magenta, "Fair"
733
-
| _ -> `Red, "Poor"
734
-
in
735
-
let bar_width = 40 in
736
-
let filled = int_of_float (score /. 100.0 *. float_of_int bar_width) in
737
-
let bar = String.make filled '#' ^ String.make (bar_width - filled) '-' in
738
-
Fmt.pr "%a@."
739
-
Fmt.(styled `Bold string) "Overall Quality Score";
740
-
Fmt.pr " %a %.1f/100 %a@.@."
741
-
Fmt.(styled (`Fg score_color) string) bar
742
-
score
743
-
Fmt.(styled (`Fg score_color) (styled `Bold string)) (Printf.sprintf "(%s)" score_label);
744
-
745
-
(* Entry statistics *)
746
-
Fmt.pr "%a %a@."
747
-
Fmt.(styled `Bold string) "📊 Entries:"
748
-
Fmt.(styled (`Fg `Yellow) (styled `Bold string))
749
-
(string_of_int (River.Quality.total_entries metrics));
750
-
Fmt.pr "@.";
751
-
752
-
(* Completeness metrics with visual indicators *)
753
-
Fmt.pr "%a@." Fmt.(styled `Bold string) "Completeness";
754
-
let total = River.Quality.total_entries metrics in
755
-
let pct entries =
756
-
float_of_int entries /. float_of_int total *. 100.0
757
-
in
758
-
let show_metric label count =
759
-
let p = pct count in
760
-
let icon, color = match p with
761
-
| p when p >= 90.0 -> "✓", `Green
762
-
| p when p >= 50.0 -> "○", `Yellow
763
-
| _ -> "✗", `Red
764
-
in
765
-
Fmt.pr " %a %s %3d/%d %a@."
766
-
Fmt.(styled (`Fg color) string) icon
767
-
label
768
-
count total
769
-
Fmt.(styled `Faint string) (Printf.sprintf "(%.1f%%)" p)
770
-
in
771
-
show_metric "Content: " (River.Quality.entries_with_content metrics);
772
-
show_metric "Dates: " (River.Quality.entries_with_date metrics);
773
-
show_metric "Authors: " (River.Quality.entries_with_author metrics);
774
-
show_metric "Summaries:" (River.Quality.entries_with_summary metrics);
775
-
show_metric "Tags: " (River.Quality.entries_with_tags metrics);
776
-
Fmt.pr "@.";
777
-
778
-
(* Content statistics *)
779
-
if River.Quality.entries_with_content metrics > 0 then begin
780
-
Fmt.pr "%a@." Fmt.(styled `Bold string) "Content Statistics";
781
-
Fmt.pr " %a %.0f chars@."
782
-
Fmt.(styled `Faint string) "Average:"
783
-
(River.Quality.avg_content_length metrics);
784
-
Fmt.pr " %a %a ... %a@.@."
785
-
Fmt.(styled `Faint string) "Range: "
786
-
Fmt.(styled (`Fg `Cyan) string) (string_of_int (River.Quality.min_content_length metrics))
787
-
Fmt.(styled (`Fg `Cyan) string) (string_of_int (River.Quality.max_content_length metrics))
788
-
end;
789
-
790
-
(* Posting frequency *)
791
-
(match River.Quality.posting_frequency_days metrics with
792
-
| Some freq ->
793
-
Fmt.pr "%a@." Fmt.(styled `Bold string) "Posting Frequency";
794
-
let posts_per_week = 7.0 /. freq in
795
-
Fmt.pr " %a %.1f days between posts@."
796
-
Fmt.(styled `Faint string) "Average:"
797
-
freq;
798
-
Fmt.pr " %a ~%.1f posts/week@.@."
799
-
Fmt.(styled `Faint string) " "
800
-
posts_per_week
801
-
| None ->
802
-
Fmt.pr "%a@.@." Fmt.(styled `Faint string)
803
-
"Not enough data to calculate posting frequency");
804
-
805
-
Fmt.pr "@.";
806
-
0
807
-
) $ username_arg)
808
-
809
583
let main_cmd =
810
584
let doc = "River feed management CLI" in
811
585
let main_info = Cmd.info "river-cli" ~version:"1.0" ~doc in
···
841
615
~service:"river"
842
616
merge
843
617
in
844
-
let quality_cmd =
845
-
Eiocmd.run
846
-
~use_keyeio:false
847
-
~info:(Cmd.info "quality" ~doc:"Analyze feed quality metrics for a user")
848
-
~app_name:"river"
849
-
~service:"river"
850
-
quality
851
-
in
852
-
Cmd.group main_info [user_cmd; sync_cmd; list_cmd; info_cmd; merge_cmd; quality_cmd]
618
+
Cmd.group main_info [user_cmd; sync_cmd; list_cmd; info_cmd; merge_cmd]
+3
-39
stack/river/cmd/river_cmd.mli
+3
-39
stack/river/cmd/river_cmd.mli
···
14
14
15
15
(** {2 User Management Commands} *)
16
16
17
-
val user_add :
18
-
(Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t
19
-
(** [user_add] command term for adding a new user.
20
-
21
-
Reads: username, fullname, email from command-line arguments.
22
-
Calls: [River.State.create_user] *)
23
-
24
-
val user_remove :
25
-
(Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t
26
-
(** [user_remove] command term for removing a user.
27
-
28
-
Reads: username from command-line arguments.
29
-
Calls: [River.State.delete_user] *)
30
-
31
17
val user_list :
32
18
(Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t
33
-
(** [user_list] command term for listing all users.
19
+
(** [user_list] command term for listing all users from Sortal.
34
20
21
+
Reads from Sortal contact database.
35
22
Calls: [River.State.list_users] *)
36
23
37
24
val user_show :
···
41
28
Reads: username from command-line arguments.
42
29
Calls: [River.State.get_user] *)
43
30
44
-
val user_add_feed :
45
-
(Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t
46
-
(** [user_add_feed] command term for adding a feed to a user.
47
-
48
-
Reads: username, name, url from command-line arguments.
49
-
Calls: [River.State.get_user], [River.User.add_feed], [River.State.update_user] *)
50
-
51
-
val user_remove_feed :
52
-
(Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t
53
-
(** [user_remove_feed] command term for removing a feed from a user.
54
-
55
-
Reads: username, url from command-line arguments.
56
-
Calls: [River.State.get_user], [River.User.remove_feed], [River.State.update_user] *)
57
-
58
31
val user_cmd : int Cmd.t
59
-
(** [user_cmd] is the user management command group containing all user subcommands. *)
32
+
(** [user_cmd] is the user viewing command group (read-only, users managed in Sortal). *)
60
33
61
34
(** {2 Feed Sync Commands} *)
62
35
···
99
72
100
73
Reads: format (atom|jsonfeed), title, limit from command-line arguments.
101
74
Calls: [River.State.export_merged_feed] *)
102
-
103
-
(** {2 Quality Analysis Commands} *)
104
-
105
-
val quality :
106
-
(Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t
107
-
(** [quality] command term for analyzing feed quality.
108
-
109
-
Reads: username from command-line arguments.
110
-
Calls: [River.State.analyze_user_quality] *)
111
75
112
76
(** {2 Main Command} *)
113
77
+1
stack/river/dune-project
+1
stack/river/dune-project
+1
-1
stack/river/lib/dune
+1
-1
stack/river/lib/dune
···
1
1
(library
2
2
(name river)
3
3
(public_name river)
4
-
(libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime jsonfeed jsont jsont.bytesrw xdge cmdliner eiocmd fmt))
4
+
(libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime jsonfeed jsont jsont.bytesrw xdge cmdliner eiocmd fmt sortal))
+7
-2
stack/river/lib/feed.ml
+7
-2
stack/river/lib/feed.ml
···
100
100
(Source.url source) (String.length body));
101
101
body
102
102
| Error (status, msg) ->
103
+
let truncated_msg =
104
+
if String.length msg > 200
105
+
then String.sub msg 0 200 ^ "..."
106
+
else msg
107
+
in
103
108
Log.err (fun m -> m "Failed to fetch feed '%s': HTTP %d - %s"
104
-
(Source.name source) status msg);
105
-
failwith (Printf.sprintf "HTTP %d: %s" status msg)
109
+
(Source.name source) status truncated_msg);
110
+
failwith (Printf.sprintf "HTTP %d: %s" status truncated_msg)
106
111
in
107
112
108
113
let content = classify_feed ~xmlbase response in
+35
-40
stack/river/lib/river.mli
+35
-40
stack/river/lib/river.mli
···
237
237
(** {1 User Management} *)
238
238
239
239
module User : sig
240
+
(** River user composed from Sortal contact data + sync state.
241
+
242
+
User data is stored in Sortal and read on-demand. River only persists
243
+
sync timestamps and optional per-user overrides. *)
244
+
240
245
type t
241
-
(** User configuration with feed subscriptions. *)
246
+
(** A River user composed from Sortal.Contact + sync metadata. *)
242
247
243
-
val make :
244
-
username:string ->
245
-
fullname:string ->
246
-
?email:string ->
247
-
?feeds:Source.t list ->
248
-
?last_synced:string ->
249
-
unit ->
250
-
t
251
-
(** [make ~username ~fullname ()] creates a new user.
248
+
val of_contact : Sortal.Contact.t -> ?last_synced:string -> unit -> t
249
+
(** [of_contact contact ()] creates a River user from a Sortal contact.
252
250
253
-
@param username Unique username identifier
254
-
@param fullname User's display name
255
-
@param email Optional email address
256
-
@param feeds Optional list of feed sources (default: [])
251
+
@param contact The Sortal contact to base this user on
257
252
@param last_synced Optional ISO 8601 timestamp of last sync *)
258
253
259
254
val username : t -> string
260
-
(** [username user] returns the username. *)
255
+
(** [username user] returns the username (from Sortal.Contact.handle). *)
261
256
262
257
val fullname : t -> string
263
-
(** [fullname user] returns the full name. *)
258
+
(** [fullname user] returns the full name (from Sortal.Contact.primary_name). *)
264
259
265
260
val email : t -> string option
266
-
(** [email user] returns the email address if set. *)
261
+
(** [email user] returns the email address (from Sortal.Contact). *)
267
262
268
263
val feeds : t -> Source.t list
269
-
(** [feeds user] returns the list of subscribed feeds. *)
264
+
(** [feeds user] returns the list of subscribed feeds (from Sortal.Contact). *)
270
265
271
266
val last_synced : t -> string option
272
267
(** [last_synced user] returns the last sync timestamp if set. *)
273
268
274
-
val add_feed : t -> Source.t -> t
275
-
(** [add_feed user source] returns a new user with the feed added. *)
276
-
277
-
val remove_feed : t -> url:string -> t
278
-
(** [remove_feed user ~url] returns a new user with the feed removed by URL. *)
269
+
val contact : t -> Sortal.Contact.t
270
+
(** [contact user] returns the underlying Sortal contact. *)
279
271
280
272
val set_last_synced : t -> string -> t
281
273
(** [set_last_synced user timestamp] returns a new user with updated sync time. *)
282
-
283
-
val jsont : t Jsont.t
284
-
(** JSON codec for users. *)
285
274
end
286
275
287
276
(** {1 Feed Quality Analysis} *)
···
331
320
332
321
module State : sig
333
322
type t
334
-
(** State handle for managing user data and feeds on disk. *)
323
+
(** State handle for managing sync state and feeds on disk.
324
+
325
+
User contact data is read from Sortal on-demand. River only persists
326
+
sync timestamps and feed data. *)
335
327
336
328
val create :
337
329
< fs : Eio.Fs.dir_ty Eio.Path.t; .. > ->
···
340
332
(** [create env ~app_name] creates a state handle using XDG directories.
341
333
342
334
Data is stored in:
343
-
- Users: $XDG_STATE_HOME/[app_name]/users/
344
-
- Feeds: $XDG_STATE_HOME/[app_name]/feeds/user/
335
+
- Sync state: $XDG_STATE_HOME/[app_name]/sync_state.json
336
+
- Feeds: $XDG_STATE_HOME/[app_name]/feeds/[username]/
337
+
338
+
User contact data is read from Sortal's XDG location.
345
339
346
340
@param env The Eio environment with filesystem access
347
341
@param app_name Application name for XDG paths *)
348
342
349
343
(** {2 User Operations} *)
350
344
351
-
val create_user : t -> User.t -> (unit, string) result
352
-
(** [create_user state user] creates a new user.
345
+
val get_user : t -> username:string -> User.t option
346
+
(** [get_user state ~username] retrieves a user by username.
353
347
354
-
Returns [Error] if the user already exists. *)
348
+
This reads contact data from Sortal and combines it with River's sync state.
349
+
Returns [None] if the username doesn't exist in Sortal or has no feeds. *)
355
350
356
-
val delete_user : t -> username:string -> (unit, string) result
357
-
(** [delete_user state ~username] deletes a user and their feed data. *)
351
+
val list_users : t -> string list
352
+
(** [list_users state] returns all usernames with feeds from Sortal. *)
358
353
359
-
val get_user : t -> username:string -> User.t option
360
-
(** [get_user state ~username] retrieves a user by username. *)
354
+
val get_all_users : t -> User.t list
355
+
(** [get_all_users state] returns all users from Sortal with their sync state. *)
361
356
362
-
val update_user : t -> User.t -> (unit, string) result
363
-
(** [update_user state user] saves updated user configuration. *)
357
+
val update_sync_state : t -> username:string -> timestamp:string -> (unit, string) result
358
+
(** [update_sync_state state ~username ~timestamp] updates the last sync timestamp.
364
359
365
-
val list_users : t -> string list
366
-
(** [list_users state] returns all usernames. *)
360
+
@param username The user to update
361
+
@param timestamp ISO 8601 timestamp of the sync *)
367
362
368
363
(** {2 Feed Operations} *)
369
364
+89
-83
stack/river/lib/state.ml
+89
-83
stack/river/lib/state.ml
···
15
15
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
16
*)
17
17
18
-
(** State management for user data and feeds. *)
18
+
(** State management for sync state and feeds.
19
+
20
+
User contact data is read from Sortal on-demand. River only persists
21
+
sync timestamps and feed data. *)
19
22
20
23
let src = Logs.Src.create "river" ~doc:"River RSS/Atom aggregator"
21
24
module Log = (val Logs.src_log src : Logs.LOG)
22
25
23
26
type t = {
24
27
xdg : Xdge.t;
28
+
sortal : Sortal.t;
25
29
}
26
30
27
31
module Paths = struct
28
-
(** Get the users directory path *)
29
-
let users_dir state = Eio.Path.(Xdge.state_dir state.xdg / "users")
30
-
31
32
(** Get the feeds directory path *)
32
33
let feeds_dir state = Eio.Path.(Xdge.state_dir state.xdg / "feeds")
33
34
34
35
(** Get the user feeds directory path *)
35
36
let user_feeds_dir state = Eio.Path.(feeds_dir state / "user")
36
37
37
-
(** Get the path to a user's JSON file *)
38
-
let user_file state username =
39
-
Eio.Path.(users_dir state / (username ^ ".json"))
38
+
(** Get the sync state file path *)
39
+
let sync_state_file state = Eio.Path.(Xdge.state_dir state.xdg / "sync_state.json")
40
40
41
41
(** Get the path to a user's Atom feed file *)
42
42
let user_feed_file state username =
···
45
45
(** Ensure all necessary directories exist *)
46
46
let ensure_directories state =
47
47
let dirs = [
48
-
users_dir state;
49
48
feeds_dir state;
50
49
user_feeds_dir state;
51
50
] in
···
55
54
) dirs
56
55
end
57
56
58
-
module Json = struct
59
-
(** Decode a user from JSON string *)
60
-
let user_of_string s =
61
-
match Jsont_bytesrw.decode_string' User.jsont s with
62
-
| Ok user -> Some user
63
-
| Error err ->
64
-
Log.err (fun m -> m "Failed to parse user JSON: %s" (Jsont.Error.to_string err));
65
-
None
66
-
67
-
(** Encode a user to JSON string *)
68
-
let user_to_string user =
69
-
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent User.jsont user with
70
-
| Ok s -> s
71
-
| Error err -> failwith ("Failed to encode user: " ^ Jsont.Error.to_string err)
72
-
end
57
+
(** Sync state management - maps username to last_synced timestamp *)
58
+
module Sync_state = struct
59
+
let jsont =
60
+
let pair_t =
61
+
let make username timestamp = (username, timestamp) in
62
+
Jsont.Object.map ~kind:"SyncEntry" make
63
+
|> Jsont.Object.mem "username" Jsont.string ~enc:fst
64
+
|> Jsont.Object.mem "timestamp" Jsont.string ~enc:snd
65
+
|> Jsont.Object.finish
66
+
in
67
+
Jsont.Object.map ~kind:"SyncState" (fun pairs -> pairs)
68
+
|> Jsont.Object.mem "synced_users" (Jsont.list pair_t) ~enc:(fun s -> s)
69
+
|> Jsont.Object.finish
73
70
74
-
module Storage = struct
75
-
(** Load a user from disk *)
76
-
let load_user state username =
77
-
let file = Paths.user_file state username in
71
+
let load state =
72
+
let file = Paths.sync_state_file state in
78
73
try
79
74
let content = Eio.Path.load file in
80
-
Json.user_of_string content
75
+
match Jsont_bytesrw.decode_string' jsont content with
76
+
| Ok pairs -> pairs
77
+
| Error err ->
78
+
Log.warn (fun m -> m "Failed to parse sync state: %s" (Jsont.Error.to_string err));
79
+
[]
81
80
with
82
-
| Eio.Io (Eio.Fs.E (Not_found _), _) -> None
81
+
| Eio.Io (Eio.Fs.E (Not_found _), _) -> []
83
82
| e ->
84
-
Log.err (fun m -> m "Error loading user %s: %s" username (Printexc.to_string e));
85
-
None
83
+
Log.err (fun m -> m "Error loading sync state: %s" (Printexc.to_string e));
84
+
[]
85
+
86
+
let save state sync_state =
87
+
let file = Paths.sync_state_file state in
88
+
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont sync_state with
89
+
| Ok json -> Eio.Path.save ~create:(`Or_truncate 0o644) file json
90
+
| Error err -> failwith ("Failed to encode sync state: " ^ Jsont.Error.to_string err)
86
91
87
-
(** Save a user to disk *)
88
-
let save_user state user =
89
-
let file = Paths.user_file state (User.username user) in
90
-
let json = Json.user_to_string user in
91
-
Eio.Path.save ~create:(`Or_truncate 0o644) file json
92
+
let get_timestamp state username =
93
+
load state |> List.assoc_opt username
94
+
95
+
let set_timestamp state username timestamp =
96
+
let sync_state = load state in
97
+
let updated = (username, timestamp) :: List.remove_assoc username sync_state in
98
+
save state updated
99
+
end
92
100
93
-
(** List all usernames *)
101
+
module Storage = struct
102
+
(** List all usernames with feeds from Sortal *)
94
103
let list_users state =
95
104
try
96
-
Eio.Path.read_dir (Paths.users_dir state)
97
-
|> List.filter_map (fun name ->
98
-
if Filename.check_suffix name ".json" then
99
-
Some (Filename.chop_suffix name ".json")
100
-
else None
101
-
)
102
-
with _ -> []
105
+
Sortal.list state.sortal
106
+
|> List.filter (fun contact -> Sortal.Contact.feeds contact <> None)
107
+
|> List.map Sortal.Contact.handle
108
+
with e ->
109
+
Log.err (fun m -> m "Error listing Sortal users: %s" (Printexc.to_string e));
110
+
[]
111
+
112
+
(** Get a user from Sortal with sync state *)
113
+
let get_user state username =
114
+
match Sortal.lookup state.sortal username with
115
+
| None -> None
116
+
| Some contact ->
117
+
(* Only return users with feeds *)
118
+
if Sortal.Contact.feeds contact = None then None
119
+
else
120
+
let last_synced = Sync_state.get_timestamp state username in
121
+
Some (User.of_contact contact ?last_synced ())
122
+
123
+
(** Get all users from Sortal with sync state *)
124
+
let get_all_users state =
125
+
try
126
+
Sortal.list state.sortal
127
+
|> List.filter (fun contact -> Sortal.Contact.feeds contact <> None)
128
+
|> List.map (fun contact ->
129
+
let username = Sortal.Contact.handle contact in
130
+
let last_synced = Sync_state.get_timestamp state username in
131
+
User.of_contact contact ?last_synced ())
132
+
with e ->
133
+
Log.err (fun m -> m "Error getting all users: %s" (Printexc.to_string e));
134
+
[]
103
135
104
136
(** Load existing Atom entries for a user *)
105
137
let load_existing_posts state username =
···
123
155
let feed = Format.Atom.feed_of_entries ~title:username entries in
124
156
let xml = Format.Atom.to_string feed in
125
157
Eio.Path.save ~create:(`Or_truncate 0o644) file xml
126
-
127
-
(** Delete a user and their feed file *)
128
-
let delete_user state username =
129
-
let user_file = Paths.user_file state username in
130
-
let feed_file = Paths.user_feed_file state username in
131
-
(try Eio.Path.unlink user_file with _ -> ());
132
-
(try Eio.Path.unlink feed_file with _ -> ())
133
158
end
134
159
135
160
module Sync = struct
···
169
194
170
195
(** Sync feeds for a single user *)
171
196
let sync_user session state ~username =
172
-
match Storage.load_user state username with
197
+
match Storage.get_user state username with
173
198
| None ->
174
199
Error (Printf.sprintf "User %s not found" username)
175
200
| Some user when User.feeds user = [] ->
···
215
240
216
241
(* Update last_synced timestamp *)
217
242
let now = current_timestamp () in
218
-
let user = User.set_last_synced user now in
219
-
Storage.save_user state user;
243
+
Sync_state.set_timestamp state username now;
220
244
221
245
Log.info (fun m -> m "Sync completed for user %s" username);
222
246
Ok ()
···
312
336
313
337
let create env ~app_name =
314
338
let xdg = Xdge.create env#fs app_name in
315
-
let state = { xdg } in
339
+
(* Sortal always uses "sortal" as the app name for shared contact database *)
340
+
let sortal = Sortal.create env#fs "sortal" in
341
+
let state = { xdg; sortal } in
316
342
Paths.ensure_directories state;
317
343
state
318
344
319
-
let create_user state user =
320
-
match Storage.load_user state (User.username user) with
321
-
| Some _ ->
322
-
Error (Printf.sprintf "User %s already exists" (User.username user))
323
-
| None ->
324
-
Storage.save_user state user;
325
-
Log.info (fun m -> m "User %s created" (User.username user));
326
-
Ok ()
327
-
328
-
let delete_user state ~username =
329
-
match Storage.load_user state username with
330
-
| None ->
331
-
Error (Printf.sprintf "User %s not found" username)
332
-
| Some _ ->
333
-
Storage.delete_user state username;
334
-
Log.info (fun m -> m "User %s deleted" username);
335
-
Ok ()
336
-
337
345
let get_user state ~username =
338
-
Storage.load_user state username
346
+
Storage.get_user state username
339
347
340
-
let update_user state user =
341
-
match Storage.load_user state (User.username user) with
342
-
| None ->
343
-
Error (Printf.sprintf "User %s not found" (User.username user))
344
-
| Some _ ->
345
-
Storage.save_user state user;
346
-
Log.info (fun m -> m "User %s updated" (User.username user));
347
-
Ok ()
348
+
let get_all_users state =
349
+
Storage.get_all_users state
348
350
349
351
let list_users state =
350
352
Storage.list_users state
353
+
354
+
let update_sync_state state ~username ~timestamp =
355
+
Sync_state.set_timestamp state username timestamp;
356
+
Ok ()
351
357
352
358
let sync_user env state ~username =
353
359
Session.with_session env @@ fun session ->
···
425
431
Export.export_jsonfeed ~title entries
426
432
427
433
let analyze_user_quality state ~username =
428
-
match Storage.load_user state username with
434
+
match Storage.get_user state username with
429
435
| None ->
430
436
Error (Printf.sprintf "User %s not found" username)
431
437
| Some _ ->
+21
-15
stack/river/lib/state.mli
+21
-15
stack/river/lib/state.mli
···
15
15
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
16
*)
17
17
18
-
(** State management for user data and feeds. *)
18
+
(** State management for sync state and feeds.
19
+
20
+
User contact data is read from Sortal on-demand. River only persists
21
+
sync timestamps and feed data. *)
19
22
20
23
type t
21
-
(** State handle for managing user data and feeds on disk. *)
24
+
(** State handle for managing sync state and feeds on disk. *)
22
25
23
26
val create :
24
27
< fs : Eio.Fs.dir_ty Eio.Path.t; .. > ->
···
27
30
(** [create env ~app_name] creates a state handle using XDG directories.
28
31
29
32
Data is stored in:
30
-
- Users: $XDG_STATE_HOME/[app_name]/users/
31
-
- Feeds: $XDG_STATE_HOME/[app_name]/feeds/user/
33
+
- Sync state: $XDG_STATE_HOME/[app_name]/sync_state.json
34
+
- Feeds: $XDG_STATE_HOME/[app_name]/feeds/[username]/
35
+
36
+
User contact data is read from Sortal's XDG location.
32
37
33
38
@param env The Eio environment with filesystem access
34
39
@param app_name Application name for XDG paths *)
35
40
36
41
(** {2 User Operations} *)
37
42
38
-
val create_user : t -> User.t -> (unit, string) result
39
-
(** [create_user state user] creates a new user.
43
+
val get_user : t -> username:string -> User.t option
44
+
(** [get_user state ~username] retrieves a user by username.
40
45
41
-
Returns [Error] if the user already exists. *)
46
+
This reads contact data from Sortal and combines it with River's sync state.
47
+
Returns [None] if the username doesn't exist in Sortal or has no feeds. *)
42
48
43
-
val delete_user : t -> username:string -> (unit, string) result
44
-
(** [delete_user state ~username] deletes a user and their feed data. *)
49
+
val list_users : t -> string list
50
+
(** [list_users state] returns all usernames with feeds from Sortal. *)
45
51
46
-
val get_user : t -> username:string -> User.t option
47
-
(** [get_user state ~username] retrieves a user by username. *)
52
+
val get_all_users : t -> User.t list
53
+
(** [get_all_users state] returns all users from Sortal with their sync state. *)
48
54
49
-
val update_user : t -> User.t -> (unit, string) result
50
-
(** [update_user state user] saves updated user configuration. *)
55
+
val update_sync_state : t -> username:string -> timestamp:string -> (unit, string) result
56
+
(** [update_sync_state state ~username ~timestamp] updates the last sync timestamp.
51
57
52
-
val list_users : t -> string list
53
-
(** [list_users state] returns all usernames. *)
58
+
@param username The user to update
59
+
@param timestamp ISO 8601 timestamp of the sync *)
54
60
55
61
(** {2 Feed Operations} *)
56
62
+19
-29
stack/river/lib/user.ml
+19
-29
stack/river/lib/user.ml
···
15
15
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
16
*)
17
17
18
-
(** User management. *)
18
+
(** River user composed from Sortal contact data + sync state. *)
19
19
20
20
type t = {
21
-
username : string;
22
-
fullname : string;
23
-
email : string option;
24
-
feeds : Source.t list;
21
+
contact : Sortal.Contact.t;
25
22
last_synced : string option;
26
23
}
27
24
28
-
let make ~username ~fullname ?email ?(feeds = []) ?last_synced () =
29
-
{ username; fullname; email; feeds; last_synced }
25
+
let of_contact contact ?last_synced () =
26
+
{ contact; last_synced }
30
27
31
-
let username t = t.username
32
-
let fullname t = t.fullname
33
-
let email t = t.email
34
-
let feeds t = t.feeds
28
+
let username t = Sortal.Contact.handle t.contact
29
+
let fullname t = Sortal.Contact.primary_name t.contact
30
+
let email t = Sortal.Contact.email t.contact
31
+
let contact t = t.contact
35
32
let last_synced t = t.last_synced
36
33
37
-
let add_feed t source =
38
-
{ t with feeds = source :: t.feeds }
39
-
40
-
let remove_feed t ~url =
41
-
let feeds = List.filter (fun s -> Source.url s <> url) t.feeds in
42
-
{ t with feeds }
34
+
let feeds t =
35
+
match Sortal.Contact.feeds t.contact with
36
+
| None -> []
37
+
| Some sortal_feeds ->
38
+
List.map (fun feed ->
39
+
let name = match Sortal.Feed.name feed with
40
+
| Some n -> n
41
+
| None -> Sortal.Contact.primary_name t.contact ^ " feed"
42
+
in
43
+
Source.make ~name ~url:(Sortal.Feed.url feed)
44
+
) sortal_feeds
43
45
44
46
let set_last_synced t timestamp =
45
47
{ t with last_synced = Some timestamp }
46
-
47
-
let jsont =
48
-
let make username fullname email feeds last_synced =
49
-
{ username; fullname; email; feeds; last_synced }
50
-
in
51
-
Jsont.Object.map ~kind:"User" make
52
-
|> Jsont.Object.mem "username" Jsont.string ~enc:(fun u -> u.username)
53
-
|> Jsont.Object.mem "fullname" Jsont.string ~enc:(fun u -> u.fullname)
54
-
|> Jsont.Object.opt_mem "email" Jsont.string ~enc:(fun u -> u.email)
55
-
|> Jsont.Object.mem "feeds" (Jsont.list Source.jsont) ~enc:(fun u -> u.feeds)
56
-
|> Jsont.Object.opt_mem "last_synced" Jsont.string ~enc:(fun u -> u.last_synced)
57
-
|> Jsont.Object.finish
+14
-27
stack/river/lib/user.mli
+14
-27
stack/river/lib/user.mli
···
15
15
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
16
*)
17
17
18
-
(** User management. *)
18
+
(** River user composed from Sortal contact data + sync state.
19
+
20
+
User data is stored in Sortal and read on-demand. River only persists
21
+
sync timestamps and optional per-user overrides. *)
19
22
20
23
type t
21
-
(** User configuration with feed subscriptions. *)
24
+
(** A River user composed from Sortal.Contact + sync metadata. *)
22
25
23
-
val make :
24
-
username:string ->
25
-
fullname:string ->
26
-
?email:string ->
27
-
?feeds:Source.t list ->
28
-
?last_synced:string ->
29
-
unit ->
30
-
t
31
-
(** [make ~username ~fullname ()] creates a new user.
26
+
val of_contact : Sortal.Contact.t -> ?last_synced:string -> unit -> t
27
+
(** [of_contact contact ()] creates a River user from a Sortal contact.
32
28
33
-
@param username Unique username identifier
34
-
@param fullname User's display name
35
-
@param email Optional email address
36
-
@param feeds Optional list of feed sources (default: [])
29
+
@param contact The Sortal contact to base this user on
37
30
@param last_synced Optional ISO 8601 timestamp of last sync *)
38
31
39
32
val username : t -> string
40
-
(** [username user] returns the username. *)
33
+
(** [username user] returns the username (from Sortal.Contact.handle). *)
41
34
42
35
val fullname : t -> string
43
-
(** [fullname user] returns the full name. *)
36
+
(** [fullname user] returns the full name (from Sortal.Contact.primary_name). *)
44
37
45
38
val email : t -> string option
46
-
(** [email user] returns the email address if set. *)
39
+
(** [email user] returns the email address (from Sortal.Contact). *)
47
40
48
41
val feeds : t -> Source.t list
49
-
(** [feeds user] returns the list of subscribed feeds. *)
42
+
(** [feeds user] returns the list of subscribed feeds (from Sortal.Contact). *)
50
43
51
44
val last_synced : t -> string option
52
45
(** [last_synced user] returns the last sync timestamp if set. *)
53
46
54
-
val add_feed : t -> Source.t -> t
55
-
(** [add_feed user source] returns a new user with the feed added. *)
56
-
57
-
val remove_feed : t -> url:string -> t
58
-
(** [remove_feed user ~url] returns a new user with the feed removed by URL. *)
47
+
val contact : t -> Sortal.Contact.t
48
+
(** [contact user] returns the underlying Sortal contact. *)
59
49
60
50
val set_last_synced : t -> string -> t
61
51
(** [set_last_synced user timestamp] returns a new user with updated sync time. *)
62
-
63
-
val jsont : t Jsont.t
64
-
(** JSON codec for users. *)