···

       
1
       
 
       
(executable

     

       
2
       
-
       
 (public_name river-cli)

     

       
3
       
 
       
 (name river_cli)

     

       
4
       
 
       
 (libraries river river_cmd cmdliner jsont jsont.bytesrw fmt fmt.tty fmt.cli eio eio_main eiocmd unix ptime syndic xdge))

     

···

       
1
       
 
       
(executable

     

       
2
       
+
       
 (public_name river)

     

       
3
       
 
       
 (name river_cli)

     

       
4
       
 
       
 (libraries river river_cmd cmdliner jsont jsont.bytesrw fmt fmt.tty fmt.cli eio eio_main eiocmd unix ptime syndic xdge))

     

···

       
10
       
 
       
let src = Logs.Src.create "river-cli" ~doc:"River CLI application"

     

       
11
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
12
       
 
       


     

       
13
       
-
       
(* User management commands *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
14
       
 
       
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
       
 
       
  let list state =

     

       
45
       
 
       
    let users = River.State.list_users state in

     

       
46
       
 
       
    if users = [] then begin

     

       
47
       
 
       
      Fmt.pr "@.%a@.@."

     

       
48
       
 
       
        Fmt.(styled `Yellow string)

     

       
49
       
-
       
        "No users found. Use 'river-cli user add' to create one."

     

       
50
       
 
       
    end else begin

     

       
51
       
 
       
      Fmt.pr "@.%a@."

     

       
52
       
 
       
        Fmt.(styled `Bold (styled (`Fg `Cyan) string))

     
···

       
73
       
 
       
    end;

     

       
74
       
 
       
    0

     

       
75
       
 
       


     

       
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
       
 
       
  let show state ~username =

     

       
126
       
 
       
    match River.State.get_user state ~username with

     

       
127
       
 
       
    | None ->

     
···

       
148
       
 
       
        Fmt.(styled `Yellow string)

     

       
149
       
 
       
        (Option.value (River.User.last_synced user) ~default:"never");

     

       
150
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
151
       
 
       
      let feeds = River.User.feeds user in

     

       
152
       
 
       
      Fmt.pr "%a@."

     

       
153
       
 
       
        Fmt.(styled `Bold string)

     
···

       
157
       
 
       
      if feeds = [] then

     

       
158
       
 
       
        Fmt.pr "%a@.@."

     

       
159
       
 
       
          Fmt.(styled `Faint string)

     

       
160
       
-
       
          "  No feeds configured. Use 'river-cli user add-feed' to add one."

     

       
161
       
 
       
      else

     

       
162
       
 
       
        List.iter (fun feed ->

     

       
163
       
 
       
          Fmt.pr "@.%a@."

     
···

       
209
       
 
       
        Fmt.(styled (`Fg `Red) string) "✗"

     

       
210
       
 
       
        err;

     

       
211
       
 
       
      1

     

       
0
       
 
       

     

       
212
       
 
       
end

     

       
213
       
 
       


     

       
214
       
 
       
(* Post listing commands *)

     
···

       
434
       
 
       
        (format_text_construct entry.title);

     

       
435
       
 
       
      Fmt.pr "%a@.@." Fmt.(styled `Bold string) (String.make 70 '=');

     

       
436
       
 
       


     

       
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 ->

     

       
0
       
 
       

     

       
442
       
 
       
          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;

     

       
447
       
 
       
      Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Published:"

     

       
448
       
 
       
        Fmt.(styled `Magenta string) (format_date entry.updated);

     

       
449
       
 
       
      Fmt.pr "%a %a@.@." Fmt.(styled `Cyan string) "ID:"

     
···

       
516
       
 
       
  let doc = "Username" in

     

       
517
       
 
       
  Arg.(required & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)

     

       
518
       
 
       


     

       
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
       
-
       


     

       
548
       
 
       
let user_list =

     

       
549
       
 
       
  Term.(const (fun env _xdg _profile ->

     

       
550
       
 
       
    let state = River.State.create env ~app_name:"river" in

     
···

       
557
       
 
       
    User.show state ~username

     

       
558
       
 
       
  ) $ username_arg)

     

       
559
       
 
       


     

       
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
       
 
       
let user_cmd =

     

       
573
       
-
       
  let doc = "Manage users" in

     

       
574
       
 
       
  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
       
 
       
  let user_list_cmd =

     

       
592
       
 
       
    Eiocmd.run

     

       
593
       
 
       
      ~use_keyeio:false

     

       
594
       
-
       
      ~info:(Cmd.info "list" ~doc:"List all users")

     

       
595
       
 
       
      ~app_name:"river"

     

       
596
       
 
       
      ~service:"river"

     

       
597
       
 
       
      user_list

     
···

       
604
       
 
       
      ~service:"river"

     

       
605
       
 
       
      user_show

     

       
606
       
 
       
  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
       
 
       
  Cmd.group info [

     

       
624
       
-
       
    user_add_cmd;

     

       
625
       
-
       
    user_remove_cmd;

     

       
626
       
 
       
    user_list_cmd;

     

       
627
       
 
       
    user_show_cmd;

     

       
628
       
-
       
    user_add_feed_cmd;

     

       
629
       
-
       
    user_remove_feed_cmd;

     

       
630
       
 
       
  ]

     

       
631
       
 
       


     

       
632
       
 
       
(* Sync command - needs Eio environment for HTTP requests *)

     
···

       
704
       
 
       
        Log.err (fun m -> m "Failed to export merged feed: %s" err);

     

       
705
       
 
       
        1

     

       
706
       
 
       
  ) $ 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
       
 
       
let main_cmd =

     

       
810
       
 
       
  let doc = "River feed management CLI" in

     

       
811
       
 
       
  let main_info = Cmd.info "river-cli" ~version:"1.0" ~doc in

     
···

       
841
       
 
       
      ~service:"river"

     

       
842
       
 
       
      merge

     

       
843
       
 
       
  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]

     

···

       
10
       
 
       
let src = Logs.Src.create "river-cli" ~doc:"River CLI application"

     

       
11
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
12
       
 
       


     

       
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 *)

     

       
22
       
 
       
module User = struct

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
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))

     
···

       
52
       
 
       
    end;

     

       
53
       
 
       
    0

     

       
54
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
55
       
 
       
  let show state ~username =

     

       
56
       
 
       
    match River.State.get_user state ~username with

     

       
57
       
 
       
    | None ->

     
···

       
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)

     
···

       
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@."

     
···

       
161
       
 
       
        Fmt.(styled (`Fg `Red) string) "✗"

     

       
162
       
 
       
        err;

     

       
163
       
 
       
      1

     

       
164
       
+
       


     

       
165
       
 
       
end

     

       
166
       
 
       


     

       
167
       
 
       
(* Post listing commands *)

     
···

       
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));

     

       
0
       
 
       

     

       
0
       
 
       

     

       
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:"

     
···

       
468
       
 
       
  let doc = "Username" in

     

       
469
       
 
       
  Arg.(required & pos 0 (some string) None & info [] ~docv:"USERNAME" ~doc)

     

       
470
       
 
       


     

       
471
       
+
       
(* User commands - read-only, users managed in Sortal *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
472
       
 
       
let user_list =

     

       
473
       
 
       
  Term.(const (fun env _xdg _profile ->

     

       
474
       
 
       
    let state = River.State.create env ~app_name:"river" in

     
···

       
481
       
 
       
    User.show state ~username

     

       
482
       
 
       
  ) $ username_arg)

     

       
483
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
484
       
 
       
let user_cmd =

     

       
485
       
+
       
  let doc = "View users from Sortal" in

     

       
486
       
 
       
  let info = Cmd.info "user" ~doc in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
487
       
 
       
  let user_list_cmd =

     

       
488
       
 
       
    Eiocmd.run

     

       
489
       
 
       
      ~use_keyeio:false

     

       
490
       
+
       
      ~info:(Cmd.info "list" ~doc:"List all users from Sortal")

     

       
491
       
 
       
      ~app_name:"river"

     

       
492
       
 
       
      ~service:"river"

     

       
493
       
 
       
      user_list

     
···

       
500
       
 
       
      ~service:"river"

     

       
501
       
 
       
      user_show

     

       
502
       
 
       
  in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
503
       
 
       
  Cmd.group info [

     

       
0
       
 
       

     

       
0
       
 
       

     

       
504
       
 
       
    user_list_cmd;

     

       
505
       
 
       
    user_show_cmd;

     

       
0
       
 
       

     

       
0
       
 
       

     

       
506
       
 
       
  ]

     

       
507
       
 
       


     

       
508
       
 
       
(* Sync command - needs Eio environment for HTTP requests *)

     
···

       
580
       
 
       
        Log.err (fun m -> m "Failed to export merged feed: %s" err);

     

       
581
       
 
       
        1

     

       
582
       
 
       
  ) $ format_arg $ title_arg $ limit_arg)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
583
       
 
       
let main_cmd =

     

       
584
       
 
       
  let doc = "River feed management CLI" in

     

       
585
       
 
       
  let main_info = Cmd.info "river-cli" ~version:"1.0" ~doc in

     
···

       
615
       
 
       
      ~service:"river"

     

       
616
       
 
       
      merge

     

       
617
       
 
       
  in

     

       
618
       
+
       
  Cmd.group main_info [user_cmd; sync_cmd; list_cmd; info_cmd; merge_cmd]

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

···

       
14
       
 
       


     

       
15
       
 
       
(** {2 User Management Commands} *)

     

       
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
       
 
       
val user_list :

     

       
32
       
 
       
  (Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t

     

       
33
       
-
       
(** [user_list] command term for listing all users.

     

       
34
       
 
       


     

       
0
       
 
       

     

       
35
       
 
       
    Calls: [River.State.list_users] *)

     

       
36
       
 
       


     

       
37
       
 
       
val user_show :

     
···

       
41
       
 
       
    Reads: username from command-line arguments.

     

       
42
       
 
       
    Calls: [River.State.get_user] *)

     

       
43
       
 
       


     

       
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
       
 
       
val user_cmd : int Cmd.t

     

       
59
       
-
       
(** [user_cmd] is the user management command group containing all user subcommands. *)

     

       
60
       
 
       


     

       
61
       
 
       
(** {2 Feed Sync Commands} *)

     

       
62
       
 
       


     
···

       
99
       
 
       


     

       
100
       
 
       
    Reads: format (atom|jsonfeed), title, limit from command-line arguments.

     

       
101
       
 
       
    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
       
 
       


     

       
112
       
 
       
(** {2 Main Command} *)

     

       
113
       
 
       


     

···

       
14
       
 
       


     

       
15
       
 
       
(** {2 User Management Commands} *)

     

       
16
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
17
       
 
       
val user_list :

     

       
18
       
 
       
  (Eio_unix.Stdenv.base -> Xdge.t -> Keyeio.Profile.t -> int) Term.t

     

       
19
       
+
       
(** [user_list] command term for listing all users from Sortal.

     

       
20
       
 
       


     

       
21
       
+
       
    Reads from Sortal contact database.

     

       
22
       
 
       
    Calls: [River.State.list_users] *)

     

       
23
       
 
       


     

       
24
       
 
       
val user_show :

     
···

       
28
       
 
       
    Reads: username from command-line arguments.

     

       
29
       
 
       
    Calls: [River.State.get_user] *)

     

       
30
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
31
       
 
       
val user_cmd : int Cmd.t

     

       
32
       
+
       
(** [user_cmd] is the user viewing command group (read-only, users managed in Sortal). *)

     

       
33
       
 
       


     

       
34
       
 
       
(** {2 Feed Sync Commands} *)

     

       
35
       
 
       


     
···

       
72
       
 
       


     

       
73
       
 
       
    Reads: format (atom|jsonfeed), title, limit from command-line arguments.

     

       
74
       
 
       
    Calls: [River.State.export_merged_feed] *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
75
       
 
       


     

       
76
       
 
       
(** {2 Main Command} *)

     

       
77
       
 
       


     

···

       
42
       
 
       
  (jsonfeed (>= 1.1.0))

     

       
43
       
 
       
  (jsont (>= 0.2.0))

     

       
44
       
 
       
  (jsont.bytesrw (>= 0.2.0))

     

       
0
       
 
       

     

       
45
       
 
       
  (odoc :with-doc)))

     

···

       
42
       
 
       
  (jsonfeed (>= 1.1.0))

     

       
43
       
 
       
  (jsont (>= 0.2.0))

     

       
44
       
 
       
  (jsont.bytesrw (>= 0.2.0))

     

       
45
       
+
       
  sortal

     

       
46
       
 
       
  (odoc :with-doc)))

     

···

       
1
       
 
       
(library

     

       
2
       
 
       
 (name river)

     

       
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))

     

···

       
1
       
 
       
(library

     

       
2
       
 
       
 (name river)

     

       
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 sortal))

     

···

       
100
       
 
       
          (Source.url source) (String.length body));

     

       
101
       
 
       
        body

     

       
102
       
 
       
    | Error (status, msg) ->

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
103
       
 
       
        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)

     

       
106
       
 
       
  in

     

       
107
       
 
       


     

       
108
       
 
       
  let content = classify_feed ~xmlbase response in

     

···

       
100
       
 
       
          (Source.url source) (String.length body));

     

       
101
       
 
       
        body

     

       
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

     

       
108
       
 
       
        Log.err (fun m -> m "Failed to fetch feed '%s': HTTP %d - %s"

     

       
109
       
+
       
          (Source.name source) status truncated_msg);

     

       
110
       
+
       
        failwith (Printf.sprintf "HTTP %d: %s" status truncated_msg)

     

       
111
       
 
       
  in

     

       
112
       
 
       


     

       
113
       
 
       
  let content = classify_feed ~xmlbase response in

     

···

       
237
       
 
       
(** {1 User Management} *)

     

       
238
       
 
       


     

       
239
       
 
       
module User : sig

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
240
       
 
       
  type t

     

       
241
       
-
       
  (** User configuration with feed subscriptions. *)

     

       
242
       
 
       


     

       
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.

     

       
252
       
 
       


     

       
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: [])

     

       
257
       
 
       
      @param last_synced Optional ISO 8601 timestamp of last sync *)

     

       
258
       
 
       


     

       
259
       
 
       
  val username : t -> string

     

       
260
       
-
       
  (** [username user] returns the username. *)

     

       
261
       
 
       


     

       
262
       
 
       
  val fullname : t -> string

     

       
263
       
-
       
  (** [fullname user] returns the full name. *)

     

       
264
       
 
       


     

       
265
       
 
       
  val email : t -> string option

     

       
266
       
-
       
  (** [email user] returns the email address if set. *)

     

       
267
       
 
       


     

       
268
       
 
       
  val feeds : t -> Source.t list

     

       
269
       
-
       
  (** [feeds user] returns the list of subscribed feeds. *)

     

       
270
       
 
       


     

       
271
       
 
       
  val last_synced : t -> string option

     

       
272
       
 
       
  (** [last_synced user] returns the last sync timestamp if set. *)

     

       
273
       
 
       


     

       
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. *)

     

       
279
       
 
       


     

       
280
       
 
       
  val set_last_synced : t -> string -> t

     

       
281
       
 
       
  (** [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
       
 
       
end

     

       
286
       
 
       


     

       
287
       
 
       
(** {1 Feed Quality Analysis} *)

     
···

       
331
       
 
       


     

       
332
       
 
       
module State : sig

     

       
333
       
 
       
  type t

     

       
334
       
-
       
  (** State handle for managing user data and feeds on disk. *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
335
       
 
       


     

       
336
       
 
       
  val create :

     

       
337
       
 
       
    < fs : Eio.Fs.dir_ty Eio.Path.t; .. > ->

     
···

       
340
       
 
       
  (** [create env ~app_name] creates a state handle using XDG directories.

     

       
341
       
 
       


     

       
342
       
 
       
      Data is stored in:

     

       
343
       
-
       
      - Users: $XDG_STATE_HOME/[app_name]/users/

     

       
344
       
-
       
      - Feeds: $XDG_STATE_HOME/[app_name]/feeds/user/

     

       
0
       
 
       

     

       
0
       
 
       

     

       
345
       
 
       


     

       
346
       
 
       
      @param env The Eio environment with filesystem access

     

       
347
       
 
       
      @param app_name Application name for XDG paths *)

     

       
348
       
 
       


     

       
349
       
 
       
  (** {2 User Operations} *)

     

       
350
       
 
       


     

       
351
       
-
       
  val create_user : t -> User.t -> (unit, string) result

     

       
352
       
-
       
  (** [create_user state user] creates a new user.

     

       
353
       
 
       


     

       
354
       
-
       
      Returns [Error] if the user already exists. *)

     

       
0
       
 
       

     

       
355
       
 
       


     

       
356
       
-
       
  val delete_user : t -> username:string -> (unit, string) result

     

       
357
       
-
       
  (** [delete_user state ~username] deletes a user and their feed data. *)

     

       
358
       
 
       


     

       
359
       
-
       
  val get_user : t -> username:string -> User.t option

     

       
360
       
-
       
  (** [get_user state ~username] retrieves a user by username. *)

     

       
361
       
 
       


     

       
362
       
-
       
  val update_user : t -> User.t -> (unit, string) result

     

       
363
       
-
       
  (** [update_user state user] saves updated user configuration. *)

     

       
364
       
 
       


     

       
365
       
-
       
  val list_users : t -> string list

     

       
366
       
-
       
  (** [list_users state] returns all usernames. *)

     

       
367
       
 
       


     

       
368
       
 
       
  (** {2 Feed Operations} *)

     

       
369
       
 
       


     

···

       
237
       
 
       
(** {1 User Management} *)

     

       
238
       
 
       


     

       
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
       
+
       


     

       
245
       
 
       
  type t

     

       
246
       
+
       
  (** A River user composed from Sortal.Contact + sync metadata. *)

     

       
247
       
 
       


     

       
248
       
+
       
  val of_contact : Sortal.Contact.t -> ?last_synced:string -> unit -> t

     

       
249
       
+
       
  (** [of_contact contact ()] creates a River user from a Sortal contact.

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
250
       
 
       


     

       
251
       
+
       
      @param contact The Sortal contact to base this user on

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
252
       
 
       
      @param last_synced Optional ISO 8601 timestamp of last sync *)

     

       
253
       
 
       


     

       
254
       
 
       
  val username : t -> string

     

       
255
       
+
       
  (** [username user] returns the username (from Sortal.Contact.handle). *)

     

       
256
       
 
       


     

       
257
       
 
       
  val fullname : t -> string

     

       
258
       
+
       
  (** [fullname user] returns the full name (from Sortal.Contact.primary_name). *)

     

       
259
       
 
       


     

       
260
       
 
       
  val email : t -> string option

     

       
261
       
+
       
  (** [email user] returns the email address (from Sortal.Contact). *)

     

       
262
       
 
       


     

       
263
       
 
       
  val feeds : t -> Source.t list

     

       
264
       
+
       
  (** [feeds user] returns the list of subscribed feeds (from Sortal.Contact). *)

     

       
265
       
 
       


     

       
266
       
 
       
  val last_synced : t -> string option

     

       
267
       
 
       
  (** [last_synced user] returns the last sync timestamp if set. *)

     

       
268
       
 
       


     

       
269
       
+
       
  val contact : t -> Sortal.Contact.t

     

       
270
       
+
       
  (** [contact user] returns the underlying Sortal contact. *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
271
       
 
       


     

       
272
       
 
       
  val set_last_synced : t -> string -> t

     

       
273
       
 
       
  (** [set_last_synced user timestamp] returns a new user with updated sync time. *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
274
       
 
       
end

     

       
275
       
 
       


     

       
276
       
 
       
(** {1 Feed Quality Analysis} *)

     
···

       
320
       
 
       


     

       
321
       
 
       
module State : sig

     

       
322
       
 
       
  type t

     

       
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. *)

     

       
327
       
 
       


     

       
328
       
 
       
  val create :

     

       
329
       
 
       
    < fs : Eio.Fs.dir_ty Eio.Path.t; .. > ->

     
···

       
332
       
 
       
  (** [create env ~app_name] creates a state handle using XDG directories.

     

       
333
       
 
       


     

       
334
       
 
       
      Data is stored in:

     

       
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.

     

       
339
       
 
       


     

       
340
       
 
       
      @param env The Eio environment with filesystem access

     

       
341
       
 
       
      @param app_name Application name for XDG paths *)

     

       
342
       
 
       


     

       
343
       
 
       
  (** {2 User Operations} *)

     

       
344
       
 
       


     

       
345
       
+
       
  val get_user : t -> username:string -> User.t option

     

       
346
       
+
       
  (** [get_user state ~username] retrieves a user by username.

     

       
347
       
 
       


     

       
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. *)

     

       
350
       
 
       


     

       
351
       
+
       
  val list_users : t -> string list

     

       
352
       
+
       
  (** [list_users state] returns all usernames with feeds from Sortal. *)

     

       
353
       
 
       


     

       
354
       
+
       
  val get_all_users : t -> User.t list

     

       
355
       
+
       
  (** [get_all_users state] returns all users from Sortal with their sync state. *)

     

       
356
       
 
       


     

       
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.

     

       
359
       
 
       


     

       
360
       
+
       
      @param username The user to update

     

       
361
       
+
       
      @param timestamp ISO 8601 timestamp of the sync *)

     

       
362
       
 
       


     

       
363
       
 
       
  (** {2 Feed Operations} *)

     

       
364
       
 
       


     

···

       
15
       
 
       
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

     

       
16
       
 
       
 *)

     

       
17
       
 
       


     

       
18
       
-
       
(** State management for user data and feeds. *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
19
       
 
       


     

       
20
       
 
       
let src = Logs.Src.create "river" ~doc:"River RSS/Atom aggregator"

     

       
21
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
22
       
 
       


     

       
23
       
 
       
type t = {

     

       
24
       
 
       
  xdg : Xdge.t;

     

       
0
       
 
       

     

       
25
       
 
       
}

     

       
26
       
 
       


     

       
27
       
 
       
module Paths = struct

     

       
28
       
-
       
  (** Get the users directory path *)

     

       
29
       
-
       
  let users_dir state = Eio.Path.(Xdge.state_dir state.xdg / "users")

     

       
30
       
-
       


     

       
31
       
 
       
  (** Get the feeds directory path *)

     

       
32
       
 
       
  let feeds_dir state = Eio.Path.(Xdge.state_dir state.xdg / "feeds")

     

       
33
       
 
       


     

       
34
       
 
       
  (** Get the user feeds directory path *)

     

       
35
       
 
       
  let user_feeds_dir state = Eio.Path.(feeds_dir state / "user")

     

       
36
       
 
       


     

       
37
       
-
       
  (** Get the path to a user's JSON file *)

     

       
38
       
-
       
  let user_file state username =

     

       
39
       
-
       
    Eio.Path.(users_dir state / (username ^ ".json"))

     

       
40
       
 
       


     

       
41
       
 
       
  (** Get the path to a user's Atom feed file *)

     

       
42
       
 
       
  let user_feed_file state username =

     
···

       
45
       
 
       
  (** Ensure all necessary directories exist *)

     

       
46
       
 
       
  let ensure_directories state =

     

       
47
       
 
       
    let dirs = [

     

       
48
       
-
       
      users_dir state;

     

       
49
       
 
       
      feeds_dir state;

     

       
50
       
 
       
      user_feeds_dir state;

     

       
51
       
 
       
    ] in

     
···

       
55
       
 
       
    ) dirs

     

       
56
       
 
       
end

     

       
57
       
 
       


     

       
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

     

       
73
       
 
       


     

       
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

     

       
78
       
 
       
    try

     

       
79
       
 
       
      let content = Eio.Path.load file in

     

       
80
       
-
       
      Json.user_of_string content

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
81
       
 
       
    with

     

       
82
       
-
       
    | Eio.Io (Eio.Fs.E (Not_found _), _) -> None

     

       
83
       
 
       
    | e ->

     

       
84
       
-
       
      Log.err (fun m -> m "Error loading user %s: %s" username (Printexc.to_string e));

     

       
85
       
-
       
      None

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
86
       
 
       


     

       
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

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
92
       
 
       


     

       
93
       
-
       
  (** List all usernames *)

     

       
0
       
 
       

     

       
94
       
 
       
  let list_users state =

     

       
95
       
 
       
    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 _ -> []

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
103
       
 
       


     

       
104
       
 
       
  (** Load existing Atom entries for a user *)

     

       
105
       
 
       
  let load_existing_posts state username =

     
···

       
123
       
 
       
    let feed = Format.Atom.feed_of_entries ~title:username entries in

     

       
124
       
 
       
    let xml = Format.Atom.to_string feed in

     

       
125
       
 
       
    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
       
 
       
end

     

       
134
       
 
       


     

       
135
       
 
       
module Sync = struct

     
···

       
169
       
 
       


     

       
170
       
 
       
  (** Sync feeds for a single user *)

     

       
171
       
 
       
  let sync_user session state ~username =

     

       
172
       
-
       
    match Storage.load_user state username with

     

       
173
       
 
       
    | None ->

     

       
174
       
 
       
      Error (Printf.sprintf "User %s not found" username)

     

       
175
       
 
       
    | Some user when User.feeds user = [] ->

     
···

       
215
       
 
       


     

       
216
       
 
       
        (* Update last_synced timestamp *)

     

       
217
       
 
       
        let now = current_timestamp () in

     

       
218
       
-
       
        let user = User.set_last_synced user now in

     

       
219
       
-
       
        Storage.save_user state user;

     

       
220
       
 
       


     

       
221
       
 
       
        Log.info (fun m -> m "Sync completed for user %s" username);

     

       
222
       
 
       
        Ok ()

     
···

       
312
       
 
       


     

       
313
       
 
       
let create env ~app_name =

     

       
314
       
 
       
  let xdg = Xdge.create env#fs app_name in

     

       
315
       
-
       
  let state = { xdg } in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
316
       
 
       
  Paths.ensure_directories state;

     

       
317
       
 
       
  state

     

       
318
       
 
       


     

       
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
       
 
       
let get_user state ~username =

     

       
338
       
-
       
  Storage.load_user state username

     

       
339
       
 
       


     

       
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
       
 
       


     

       
349
       
 
       
let list_users state =

     

       
350
       
 
       
  Storage.list_users state

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
351
       
 
       


     

       
352
       
 
       
let sync_user env state ~username =

     

       
353
       
 
       
  Session.with_session env @@ fun session ->

     
···

       
425
       
 
       
      Export.export_jsonfeed ~title entries

     

       
426
       
 
       


     

       
427
       
 
       
let analyze_user_quality state ~username =

     

       
428
       
-
       
  match Storage.load_user state username with

     

       
429
       
 
       
  | None ->

     

       
430
       
 
       
    Error (Printf.sprintf "User %s not found" username)

     

       
431
       
 
       
  | Some _ ->

     

···

       
15
       
 
       
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

     

       
16
       
 
       
 *)

     

       
17
       
 
       


     

       
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. *)

     

       
22
       
 
       


     

       
23
       
 
       
let src = Logs.Src.create "river" ~doc:"River RSS/Atom aggregator"

     

       
24
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
25
       
 
       


     

       
26
       
 
       
type t = {

     

       
27
       
 
       
  xdg : Xdge.t;

     

       
28
       
+
       
  sortal : Sortal.t;

     

       
29
       
 
       
}

     

       
30
       
 
       


     

       
31
       
 
       
module Paths = struct

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
32
       
 
       
  (** Get the feeds directory path *)

     

       
33
       
 
       
  let feeds_dir state = Eio.Path.(Xdge.state_dir state.xdg / "feeds")

     

       
34
       
 
       


     

       
35
       
 
       
  (** Get the user feeds directory path *)

     

       
36
       
 
       
  let user_feeds_dir state = Eio.Path.(feeds_dir state / "user")

     

       
37
       
 
       


     

       
38
       
+
       
  (** Get the sync state file path *)

     

       
39
       
+
       
  let sync_state_file state = Eio.Path.(Xdge.state_dir state.xdg / "sync_state.json")

     

       
0
       
 
       

     

       
40
       
 
       


     

       
41
       
 
       
  (** Get the path to a user's Atom feed file *)

     

       
42
       
 
       
  let user_feed_file state username =

     
···

       
45
       
 
       
  (** Ensure all necessary directories exist *)

     

       
46
       
 
       
  let ensure_directories state =

     

       
47
       
 
       
    let dirs = [

     

       
0
       
 
       

     

       
48
       
 
       
      feeds_dir state;

     

       
49
       
 
       
      user_feeds_dir state;

     

       
50
       
 
       
    ] in

     
···

       
54
       
 
       
    ) dirs

     

       
55
       
 
       
end

     

       
56
       
 
       


     

       
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

     

       
0
       
 
       

     

       
0
       
 
       

     

       
70
       
 
       


     

       
71
       
+
       
  let load state =

     

       
72
       
+
       
    let file = Paths.sync_state_file state in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
73
       
 
       
    try

     

       
74
       
 
       
      let content = Eio.Path.load file in

     

       
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
       
+
       
          []

     

       
80
       
 
       
    with

     

       
81
       
+
       
    | Eio.Io (Eio.Fs.E (Not_found _), _) -> []

     

       
82
       
 
       
    | e ->

     

       
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)

     

       
91
       
 
       


     

       
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

     

       
100
       
 
       


     

       
101
       
+
       
module Storage = struct

     

       
102
       
+
       
  (** List all usernames with feeds from Sortal *)

     

       
103
       
 
       
  let list_users state =

     

       
104
       
 
       
    try

     

       
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
       
+
       
      []

     

       
135
       
 
       


     

       
136
       
 
       
  (** Load existing Atom entries for a user *)

     

       
137
       
 
       
  let load_existing_posts state username =

     
···

       
155
       
 
       
    let feed = Format.Atom.feed_of_entries ~title:username entries in

     

       
156
       
 
       
    let xml = Format.Atom.to_string feed in

     

       
157
       
 
       
    Eio.Path.save ~create:(`Or_truncate 0o644) file xml

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
158
       
 
       
end

     

       
159
       
 
       


     

       
160
       
 
       
module Sync = struct

     
···

       
194
       
 
       


     

       
195
       
 
       
  (** Sync feeds for a single user *)

     

       
196
       
 
       
  let sync_user session state ~username =

     

       
197
       
+
       
    match Storage.get_user state username with

     

       
198
       
 
       
    | None ->

     

       
199
       
 
       
      Error (Printf.sprintf "User %s not found" username)

     

       
200
       
 
       
    | Some user when User.feeds user = [] ->

     
···

       
240
       
 
       


     

       
241
       
 
       
        (* Update last_synced timestamp *)

     

       
242
       
 
       
        let now = current_timestamp () in

     

       
243
       
+
       
        Sync_state.set_timestamp state username now;

     

       
0
       
 
       

     

       
244
       
 
       


     

       
245
       
 
       
        Log.info (fun m -> m "Sync completed for user %s" username);

     

       
246
       
 
       
        Ok ()

     
···

       
336
       
 
       


     

       
337
       
 
       
let create env ~app_name =

     

       
338
       
 
       
  let xdg = Xdge.create env#fs app_name 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

     

       
342
       
 
       
  Paths.ensure_directories state;

     

       
343
       
 
       
  state

     

       
344
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
345
       
 
       
let get_user state ~username =

     

       
346
       
+
       
  Storage.get_user state username

     

       
347
       
 
       


     

       
348
       
+
       
let get_all_users state =

     

       
349
       
+
       
  Storage.get_all_users state

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
350
       
 
       


     

       
351
       
 
       
let list_users state =

     

       
352
       
 
       
  Storage.list_users state

     

       
353
       
+
       


     

       
354
       
+
       
let update_sync_state state ~username ~timestamp =

     

       
355
       
+
       
  Sync_state.set_timestamp state username timestamp;

     

       
356
       
+
       
  Ok ()

     

       
357
       
 
       


     

       
358
       
 
       
let sync_user env state ~username =

     

       
359
       
 
       
  Session.with_session env @@ fun session ->

     
···

       
431
       
 
       
      Export.export_jsonfeed ~title entries

     

       
432
       
 
       


     

       
433
       
 
       
let analyze_user_quality state ~username =

     

       
434
       
+
       
  match Storage.get_user state username with

     

       
435
       
 
       
  | None ->

     

       
436
       
 
       
    Error (Printf.sprintf "User %s not found" username)

     

       
437
       
 
       
  | Some _ ->