commit ffb79c4c437bb0dcf637cba9d172faaf87ed0104 · anil.recoil.org/slop

+1 -1

stack/river/bin/dune

···

       1
       1
        
       (executable

     

       2
       2
       -
        (public_name river-cli)

     

       2
       2
       +
        (public_name river)

     

       3
       3
        
        (name river_cli)

     

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

+46 -280

stack/river/cmd/river_cmd.ml

···

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

     

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

     

       12
       12
        
       

     

       13
       13
       -
       (* User management commands *)

     

       13
       13
       +
       (* User display formatting *)

     

       14
       14
       +
       module User_fmt = struct

     

       15
       15
       +
         let pp_user_with_handle ppf (handle, fullname) =

     

       16
       16
       +
           Fmt.pf ppf "%a (%a)"

     

       17
       17
       +
             Fmt.(styled (`Fg `Cyan) string) handle

     

       18
       18
       +
             Fmt.(styled `Green string) fullname

     

       19
       19
       +
       end

     

       20
       20
       +
       

     

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

     

       14
       22
        
       module User = struct

     

       15
       15
       -
         let add state ~username ~fullname ~email =

     

       16
       16
       -
           let user = River.User.make ~username ~fullname ?email () in

     

       17
       17
       -
           match River.State.create_user state user with

     

       18
       18
       -
           | Ok () ->

     

       19
       19
       -
             Fmt.pr "@.%a %a %a@.@."

     

       20
       20
       -
               Fmt.(styled (`Fg `Green) string) "✓"

     

       21
       21
       -
               Fmt.(styled `Bold string) "User created:"

     

       22
       22
       -
               Fmt.(styled (`Fg `Cyan) string) username;

     

       23
       23
       -
             0

     

       24
       24
       -
           | Error err ->

     

       25
       25
       -
             Fmt.pr "@.%a %s@.@."

     

       26
       26
       -
               Fmt.(styled (`Fg `Red) string) "✗ Error:"

     

       27
       27
       -
               err;

     

       28
       28
       -
             1

     

       29
       29
       -
       

     

       30
       30
       -
         let remove state ~username =

     

       31
       31
       -
           match River.State.delete_user state ~username with

     

       32
       32
       -
           | Ok () ->

     

       33
       33
       -
             Fmt.pr "@.%a %a %a@.@."

     

       34
       34
       -
               Fmt.(styled (`Fg `Green) string) "✓"

     

       35
       35
       -
               Fmt.(styled `Bold string) "User removed:"

     

       36
       36
       -
               Fmt.(styled (`Fg `Cyan) string) username;

     

       37
       37
       -
             0

     

       38
       38
       -
           | Error err ->

     

       39
       39
       -
             Fmt.pr "@.%a %s@.@."

     

       40
       40
       -
               Fmt.(styled (`Fg `Red) string) "✗ Error:"

     

       41
       41
       -
               err;

     

       42
       42
       -
             1

     

       43
       43
       -
       

     

       44
       23
        
         let list state =

     

       45
       24
        
           let users = River.State.list_users state in

     

       46
       25
        
           if users = [] then begin

     

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

     

       48
       27
        
               Fmt.(styled `Yellow string)

     

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

     

       28
       28
       +
               "No users found. Add contacts with feeds to Sortal to see them here."

     

       50
       29
        
           end else begin

     

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

     

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

     
···

       73
       52
        
           end;

     

       74
       53
        
           0

     

       75
       54
        
       

     

       76
       76
       -
         let add_feed state ~username ~name ~url =

     

       77
       77
       -
           match River.State.get_user state ~username with

     

       78
       78
       -
           | None ->

     

       79
       79
       -
             Fmt.pr "@.%a User %a not found@.@."

     

       80
       80
       -
               Fmt.(styled (`Fg `Red) string) "✗ Error:"

     

       81
       81
       -
               Fmt.(styled `Bold string) username;

     

       82
       82
       -
             1

     

       83
       83
       -
           | Some user ->

     

       84
       84
       -
             let source = River.Source.make ~name ~url in

     

       85
       85
       -
             let user = River.User.add_feed user source in

     

       86
       86
       -
             (match River.State.update_user state user with

     

       87
       87
       -
             | Ok () ->

     

       88
       88
       -
               Fmt.pr "@.%a Feed added to %a@."

     

       89
       89
       -
                 Fmt.(styled (`Fg `Green) string) "✓"

     

       90
       90
       -
                 Fmt.(styled (`Fg `Cyan) string) username;

     

       91
       91
       -
               Fmt.pr "  %a %a@."

     

       92
       92
       -
                 Fmt.(styled `Faint string) "Name:"

     

       93
       93
       -
                 Fmt.(styled `Bold string) name;

     

       94
       94
       -
               Fmt.pr "  %a %a@.@."

     

       95
       95
       -
                 Fmt.(styled `Faint string) "URL: "

     

       96
       96
       -
                 Fmt.(styled (`Fg `Blue) string) url;

     

       97
       97
       -
               0

     

       98
       98
       -
             | Error err ->

     

       99
       99
       -
               Fmt.pr "@.%a %s@.@."

     

       100
       100
       -
                 Fmt.(styled (`Fg `Red) string) "✗ Error:"

     

       101
       101
       -
                 err;

     

       102
       102
       -
               1)

     

       103
       103
       -
       

     

       104
       104
       -
         let remove_feed state ~username ~url =

     

       105
       105
       -
           match River.State.get_user state ~username with

     

       106
       106
       -
           | None ->

     

       107
       107
       -
             Fmt.pr "@.%a User %a not found@.@."

     

       108
       108
       -
               Fmt.(styled (`Fg `Red) string) "✗ Error:"

     

       109
       109
       -
               Fmt.(styled `Bold string) username;

     

       110
       110
       -
             1

     

       111
       111
       -
           | Some user ->

     

       112
       112
       -
             let user = River.User.remove_feed user ~url in

     

       113
       113
       -
             (match River.State.update_user state user with

     

       114
       114
       -
             | Ok () ->

     

       115
       115
       -
               Fmt.pr "@.%a Feed removed from %a@.@."

     

       116
       116
       -
                 Fmt.(styled (`Fg `Green) string) "✓"

     

       117
       117
       -
                 Fmt.(styled (`Fg `Cyan) string) username;

     

       118
       118
       -
               0

     

       119
       119
       -
             | Error err ->

     

       120
       120
       -
               Fmt.pr "@.%a %s@.@."

     

       121
       121
       -
                 Fmt.(styled (`Fg `Red) string) "✗ Error:"

     

       122
       122
       -
                 err;

     

       123
       123
       -
               1)

     

       124
       124
       -
       

     

       125
       55
        
         let show state ~username =

     

       126
       56
        
           match River.State.get_user state ~username with

     

       127
       57
        
           | None ->

     
···

       148
       78
        
               Fmt.(styled `Yellow string)

     

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

     

       150
       80
        
       

     

       81
       81
       +
             (* Quality analysis *)

     

       82
       82
       +
             (match River.State.analyze_user_quality state ~username with

     

       83
       83
       +
             | Ok metrics ->

     

       84
       84
       +
                 let score = River.Quality.quality_score metrics in

     

       85
       85
       +
                 let total = River.Quality.total_entries metrics in

     

       86
       86
       +
                 let score_color, score_label = match score with

     

       87
       87
       +
                   | s when s >= 80.0 -> `Green, "Excellent"

     

       88
       88
       +
                   | s when s >= 60.0 -> `Yellow, "Good"

     

       89
       89
       +
                   | s when s >= 40.0 -> `Magenta, "Fair"

     

       90
       90
       +
                   | _ -> `Red, "Poor"

     

       91
       91
       +
                 in

     

       92
       92
       +
                 Fmt.pr "%a %a %.1f/100 %a - %d posts@.@."

     

       93
       93
       +
                   Fmt.(styled `Faint string) "Quality:  "

     

       94
       94
       +
                   Fmt.(styled (`Fg score_color) string) "●"

     

       95
       95
       +
                   score

     

       96
       96
       +
                   Fmt.(styled (`Fg score_color) string) (Printf.sprintf "(%s)" score_label)

     

       97
       97
       +
                   total

     

       98
       98
       +
             | Error _ ->

     

       99
       99
       +
                 Fmt.pr "%a %a@.@."

     

       100
       100
       +
                   Fmt.(styled `Faint string) "Quality:  "

     

       101
       101
       +
                   Fmt.(styled `Faint string) "(not synced yet)");

     

       102
       102
       +
       

     

       151
       103
        
             let feeds = River.User.feeds user in

     

       152
       104
        
             Fmt.pr "%a@."

     

       153
       105
        
               Fmt.(styled `Bold string)

     
···

       157
       109
        
             if feeds = [] then

     

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

     

       159
       111
        
                 Fmt.(styled `Faint string)

     

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

     

       112
       112
       +
                 "  No feeds configured for this contact."

     

       161
       113
        
             else

     

       162
       114
        
               List.iter (fun feed ->

     

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

     
···

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

     

       210
       162
        
               err;

     

       211
       163
        
             1

     

       164
       164
       +
       

     

       212
       165
        
       end

     

       213
       166
        
       

     

       214
       167
        
       (* Post listing commands *)

     
···

       434
       387
        
               (format_text_construct entry.title);

     

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

     

       436
       389
        
       

     

       437
       437
       -
             (* Author and date *)

     

       438
       438
       -
             let author_name =

     

       439
       439
       -
               match River.State.get_user state ~username with

     

       440
       440
       -
               | Some user -> River.User.fullname user

     

       441
       441
       -
               | None ->

     

       390
       390
       +
             (* Author and date - show handle and full name *)

     

       391
       391
       +
             (match River.State.get_user state ~username with

     

       392
       392
       +
             | Some user ->

     

       393
       393
       +
                 Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Author:"

     

       394
       394
       +
                   User_fmt.pp_user_with_handle (username, River.User.fullname user)

     

       395
       395
       +
             | None ->

     

       442
       396
        
                 let (author, _) = entry.authors in

     

       443
       443
       -
                 String.trim author.name

     

       444
       444
       -
             in

     

       445
       445
       -
             Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Author:"

     

       446
       446
       -
               Fmt.(styled `Green string) author_name;

     

       397
       397
       +
                 Fmt.pr "%a %a@." Fmt.(styled `Cyan string) "Author:"

     

       398
       398
       +
                   Fmt.(styled `Green string) (String.trim author.name));

     

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

     

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

     

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

     
···

       516
       468
        
         let doc = "Username" in

     

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

     

       518
       470
        
       

     

       519
       519
       -
       let fullname_arg =

     

       520
       520
       -
         let doc = "Full name of the user" in

     

       521
       521
       -
         Arg.(required & opt (some string) None & info ["name"; "n"] ~doc)

     

       522
       522
       -
       

     

       523
       523
       -
       let email_arg =

     

       524
       524
       -
         let doc = "Email address of the user (optional)" in

     

       525
       525
       -
         Arg.(value & opt (some string) None & info ["email"; "e"] ~doc)

     

       526
       526
       -
       

     

       527
       527
       -
       let feed_name_arg =

     

       528
       528
       -
         let doc = "Feed name/label" in

     

       529
       529
       -
         Arg.(required & opt (some string) None & info ["name"; "n"] ~doc)

     

       530
       530
       -
       

     

       531
       531
       -
       let feed_url_arg =

     

       532
       532
       -
         let doc = "Feed URL" in

     

       533
       533
       -
         Arg.(required & opt (some string) None & info ["url"; "u"] ~doc)

     

       534
       534
       -
       

     

       535
       535
       -
       (* User commands - these don't need network, just filesystem access *)

     

       536
       536
       -
       let user_add =

     

       537
       537
       -
         Term.(const (fun username fullname email env _xdg _profile ->

     

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

     

       539
       539
       -
           User.add state ~username ~fullname ~email

     

       540
       540
       -
         ) $ username_arg $ fullname_arg $ email_arg)

     

       541
       541
       -
       

     

       542
       542
       -
       let user_remove =

     

       543
       543
       -
         Term.(const (fun username env _xdg _profile ->

     

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

     

       545
       545
       -
           User.remove state ~username

     

       546
       546
       -
         ) $ username_arg)

     

       547
       547
       -
       

     

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

     

       548
       472
        
       let user_list =

     

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

     

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

     
···

       557
       481
        
           User.show state ~username

     

       558
       482
        
         ) $ username_arg)

     

       559
       483
        
       

     

       560
       560
       -
       let user_add_feed =

     

       561
       561
       -
         Term.(const (fun username name url env _xdg _profile ->

     

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

     

       563
       563
       -
           User.add_feed state ~username ~name ~url

     

       564
       564
       -
         ) $ username_arg $ feed_name_arg $ feed_url_arg)

     

       565
       565
       -
       

     

       566
       566
       -
       let user_remove_feed =

     

       567
       567
       -
         Term.(const (fun username url env _xdg _profile ->

     

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

     

       569
       569
       -
           User.remove_feed state ~username ~url

     

       570
       570
       -
         ) $ username_arg $ feed_url_arg)

     

       571
       571
       -
       

     

       572
       484
        
       let user_cmd =

     

       573
       573
       -
         let doc = "Manage users" in

     

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

     

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

     

       575
       575
       -
         let user_add_cmd =

     

       576
       576
       -
           Eiocmd.run

     

       577
       577
       -
             ~use_keyeio:false

     

       578
       578
       -
             ~info:(Cmd.info "add" ~doc:"Add a new user")

     

       579
       579
       -
             ~app_name:"river"

     

       580
       580
       -
             ~service:"river"

     

       581
       581
       -
             user_add

     

       582
       582
       -
         in

     

       583
       583
       -
         let user_remove_cmd =

     

       584
       584
       -
           Eiocmd.run

     

       585
       585
       -
             ~use_keyeio:false

     

       586
       586
       -
             ~info:(Cmd.info "remove" ~doc:"Remove a user")

     

       587
       587
       -
             ~app_name:"river"

     

       588
       588
       -
             ~service:"river"

     

       589
       589
       -
             user_remove

     

       590
       590
       -
         in

     

       591
       487
        
         let user_list_cmd =

     

       592
       488
        
           Eiocmd.run

     

       593
       489
        
             ~use_keyeio:false

     

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

     

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

     

       595
       491
        
             ~app_name:"river"

     

       596
       492
        
             ~service:"river"

     

       597
       493
        
             user_list

     
···

       604
       500
        
             ~service:"river"

     

       605
       501
        
             user_show

     

       606
       502
        
         in

     

       607
       607
       -
         let user_add_feed_cmd =

     

       608
       608
       -
           Eiocmd.run

     

       609
       609
       -
             ~use_keyeio:false

     

       610
       610
       -
             ~info:(Cmd.info "add-feed" ~doc:"Add a feed to a user")

     

       611
       611
       -
             ~app_name:"river"

     

       612
       612
       -
             ~service:"river"

     

       613
       613
       -
             user_add_feed

     

       614
       614
       -
         in

     

       615
       615
       -
         let user_remove_feed_cmd =

     

       616
       616
       -
           Eiocmd.run

     

       617
       617
       -
             ~use_keyeio:false

     

       618
       618
       -
             ~info:(Cmd.info "remove-feed" ~doc:"Remove a feed from a user")

     

       619
       619
       -
             ~app_name:"river"

     

       620
       620
       -
             ~service:"river"

     

       621
       621
       -
             user_remove_feed

     

       622
       622
       -
         in

     

       623
       503
        
         Cmd.group info [

     

       624
       624
       -
           user_add_cmd;

     

       625
       625
       -
           user_remove_cmd;

     

       626
       504
        
           user_list_cmd;

     

       627
       505
        
           user_show_cmd;

     

       628
       628
       -
           user_add_feed_cmd;

     

       629
       629
       -
           user_remove_feed_cmd;

     

       630
       506
        
         ]

     

       631
       507
        
       

     

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

     
···

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

     

       705
       581
        
               1

     

       706
       582
        
         ) $ format_arg $ title_arg $ limit_arg)

     

       707
       707
       -
       

     

       708
       708
       -
       (* Quality command - analyze feed quality *)

     

       709
       709
       -
       let quality =

     

       710
       710
       -
         let username_arg =

     

       711
       711
       -
           let doc = "Username to analyze" in

     

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

     

       713
       713
       -
         in

     

       714
       714
       -
         Term.(const (fun username env _xdg _profile ->

     

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

     

       716
       716
       -
           match River.State.analyze_user_quality state ~username with

     

       717
       717
       -
           | Error err ->

     

       718
       718
       -
               Log.err (fun m -> m "%s" err);

     

       719
       719
       -
               1

     

       720
       720
       -
           | Ok metrics ->

     

       721
       721
       -
               (* Display quality metrics *)

     

       722
       722
       -
               Fmt.pr "@.%a@."

     

       723
       723
       -
                 Fmt.(styled `Bold (styled (`Fg `Cyan) string))

     

       724
       724
       -
                 (Printf.sprintf "Feed Quality Analysis: %s" username);

     

       725
       725
       -
               Fmt.pr "%a@.@." Fmt.(styled `Faint string) (String.make 70 '=');

     

       726
       726
       -
       

     

       727
       727
       -
               (* Overall quality score with visual indicator *)

     

       728
       728
       -
               let score = River.Quality.quality_score metrics in

     

       729
       729
       -
               let score_color, score_label = match score with

     

       730
       730
       -
                 | s when s >= 80.0 -> `Green, "Excellent"

     

       731
       731
       -
                 | s when s >= 60.0 -> `Yellow, "Good"

     

       732
       732
       -
                 | s when s >= 40.0 -> `Magenta, "Fair"

     

       733
       733
       -
                 | _ -> `Red, "Poor"

     

       734
       734
       -
               in

     

       735
       735
       -
               let bar_width = 40 in

     

       736
       736
       -
               let filled = int_of_float (score /. 100.0 *. float_of_int bar_width) in

     

       737
       737
       -
               let bar = String.make filled '#' ^ String.make (bar_width - filled) '-' in

     

       738
       738
       -
               Fmt.pr "%a@."

     

       739
       739
       -
                 Fmt.(styled `Bold string) "Overall Quality Score";

     

       740
       740
       -
               Fmt.pr "  %a %.1f/100 %a@.@."

     

       741
       741
       -
                 Fmt.(styled (`Fg score_color) string) bar

     

       742
       742
       -
                 score

     

       743
       743
       -
                 Fmt.(styled (`Fg score_color) (styled `Bold string)) (Printf.sprintf "(%s)" score_label);

     

       744
       744
       -
       

     

       745
       745
       -
               (* Entry statistics *)

     

       746
       746
       -
               Fmt.pr "%a %a@."

     

       747
       747
       -
                 Fmt.(styled `Bold string) "📊 Entries:"

     

       748
       748
       -
                 Fmt.(styled (`Fg `Yellow) (styled `Bold string))

     

       749
       749
       -
                 (string_of_int (River.Quality.total_entries metrics));

     

       750
       750
       -
               Fmt.pr "@.";

     

       751
       751
       -
       

     

       752
       752
       -
               (* Completeness metrics with visual indicators *)

     

       753
       753
       -
               Fmt.pr "%a@." Fmt.(styled `Bold string) "Completeness";

     

       754
       754
       -
               let total = River.Quality.total_entries metrics in

     

       755
       755
       -
               let pct entries =

     

       756
       756
       -
                 float_of_int entries /. float_of_int total *. 100.0

     

       757
       757
       -
               in

     

       758
       758
       -
               let show_metric label count =

     

       759
       759
       -
                 let p = pct count in

     

       760
       760
       -
                 let icon, color = match p with

     

       761
       761
       -
                   | p when p >= 90.0 -> "✓", `Green

     

       762
       762
       -
                   | p when p >= 50.0 -> "○", `Yellow

     

       763
       763
       -
                   | _ -> "✗", `Red

     

       764
       764
       -
                 in

     

       765
       765
       -
                 Fmt.pr "  %a %s %3d/%d %a@."

     

       766
       766
       -
                   Fmt.(styled (`Fg color) string) icon

     

       767
       767
       -
                   label

     

       768
       768
       -
                   count total

     

       769
       769
       -
                   Fmt.(styled `Faint string) (Printf.sprintf "(%.1f%%)" p)

     

       770
       770
       -
               in

     

       771
       771
       -
               show_metric "Content:  " (River.Quality.entries_with_content metrics);

     

       772
       772
       -
               show_metric "Dates:    " (River.Quality.entries_with_date metrics);

     

       773
       773
       -
               show_metric "Authors:  " (River.Quality.entries_with_author metrics);

     

       774
       774
       -
               show_metric "Summaries:" (River.Quality.entries_with_summary metrics);

     

       775
       775
       -
               show_metric "Tags:     " (River.Quality.entries_with_tags metrics);

     

       776
       776
       -
               Fmt.pr "@.";

     

       777
       777
       -
       

     

       778
       778
       -
               (* Content statistics *)

     

       779
       779
       -
               if River.Quality.entries_with_content metrics > 0 then begin

     

       780
       780
       -
                 Fmt.pr "%a@." Fmt.(styled `Bold string) "Content Statistics";

     

       781
       781
       -
                 Fmt.pr "  %a %.0f chars@."

     

       782
       782
       -
                   Fmt.(styled `Faint string) "Average:"

     

       783
       783
       -
                   (River.Quality.avg_content_length metrics);

     

       784
       784
       -
                 Fmt.pr "  %a %a ... %a@.@."

     

       785
       785
       -
                   Fmt.(styled `Faint string) "Range:  "

     

       786
       786
       -
                   Fmt.(styled (`Fg `Cyan) string) (string_of_int (River.Quality.min_content_length metrics))

     

       787
       787
       -
                   Fmt.(styled (`Fg `Cyan) string) (string_of_int (River.Quality.max_content_length metrics))

     

       788
       788
       -
               end;

     

       789
       789
       -
       

     

       790
       790
       -
               (* Posting frequency *)

     

       791
       791
       -
               (match River.Quality.posting_frequency_days metrics with

     

       792
       792
       -
                | Some freq ->

     

       793
       793
       -
                    Fmt.pr "%a@." Fmt.(styled `Bold string) "Posting Frequency";

     

       794
       794
       -
                    let posts_per_week = 7.0 /. freq in

     

       795
       795
       -
                    Fmt.pr "  %a %.1f days between posts@."

     

       796
       796
       -
                      Fmt.(styled `Faint string) "Average:"

     

       797
       797
       -
                      freq;

     

       798
       798
       -
                    Fmt.pr "  %a ~%.1f posts/week@.@."

     

       799
       799
       -
                      Fmt.(styled `Faint string) "        "

     

       800
       800
       -
                      posts_per_week

     

       801
       801
       -
                | None ->

     

       802
       802
       -
                    Fmt.pr "%a@.@." Fmt.(styled `Faint string)

     

       803
       803
       -
                      "Not enough data to calculate posting frequency");

     

       804
       804
       -
       

     

       805
       805
       -
               Fmt.pr "@.";

     

       806
       806
       -
               0

     

       807
       807
       -
         ) $ username_arg)

     

       808
       808
       -
       

     

       809
       583
        
       let main_cmd =

     

       810
       584
        
         let doc = "River feed management CLI" in

     

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

     
···

       841
       615
        
             ~service:"river"

     

       842
       616
        
             merge

     

       843
       617
        
         in

     

       844
       844
       -
         let quality_cmd =

     

       845
       845
       -
           Eiocmd.run

     

       846
       846
       -
             ~use_keyeio:false

     

       847
       847
       -
             ~info:(Cmd.info "quality" ~doc:"Analyze feed quality metrics for a user")

     

       848
       848
       -
             ~app_name:"river"

     

       849
       849
       -
             ~service:"river"

     

       850
       850
       -
             quality

     

       851
       851
       -
         in

     

       852
       852
       -
         Cmd.group main_info [user_cmd; sync_cmd; list_cmd; info_cmd; merge_cmd; quality_cmd]

     

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

+3 -39

stack/river/cmd/river_cmd.mli

···

       14
       14
        
       

     

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

     

       16
       16
        
       

     

       17
       17
       -
       val user_add :

     

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

     

       19
       19
       -
       (** [user_add] command term for adding a new user.

     

       20
       20
       -
       

     

       21
       21
       -
           Reads: username, fullname, email from command-line arguments.

     

       22
       22
       -
           Calls: [River.State.create_user] *)

     

       23
       23
       -
       

     

       24
       24
       -
       val user_remove :

     

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

     

       26
       26
       -
       (** [user_remove] command term for removing a user.

     

       27
       27
       -
       

     

       28
       28
       -
           Reads: username from command-line arguments.

     

       29
       29
       -
           Calls: [River.State.delete_user] *)

     

       30
       30
       -
       

     

       31
       17
        
       val user_list :

     

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

     

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

     

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

     

       34
       20
        
       

     

       21
       21
       +
           Reads from Sortal contact database.

     

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

     

       36
       23
        
       

     

       37
       24
        
       val user_show :

     
···

       41
       28
        
           Reads: username from command-line arguments.

     

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

     

       43
       30
        
       

     

       44
       44
       -
       val user_add_feed :

     

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

     

       46
       46
       -
       (** [user_add_feed] command term for adding a feed to a user.

     

       47
       47
       -
       

     

       48
       48
       -
           Reads: username, name, url from command-line arguments.

     

       49
       49
       -
           Calls: [River.State.get_user], [River.User.add_feed], [River.State.update_user] *)

     

       50
       50
       -
       

     

       51
       51
       -
       val user_remove_feed :

     

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

     

       53
       53
       -
       (** [user_remove_feed] command term for removing a feed from a user.

     

       54
       54
       -
       

     

       55
       55
       -
           Reads: username, url from command-line arguments.

     

       56
       56
       -
           Calls: [River.State.get_user], [River.User.remove_feed], [River.State.update_user] *)

     

       57
       57
       -
       

     

       58
       31
        
       val user_cmd : int Cmd.t

     

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

     

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

     

       60
       33
        
       

     

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

     

       62
       35
        
       

     
···

       99
       72
        
       

     

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

     

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

     

       102
       102
       -
       

     

       103
       103
       -
       (** {2 Quality Analysis Commands} *)

     

       104
       104
       -
       

     

       105
       105
       -
       val quality :

     

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

     

       107
       107
       -
       (** [quality] command term for analyzing feed quality.

     

       108
       108
       -
       

     

       109
       109
       -
           Reads: username from command-line arguments.

     

       110
       110
       -
           Calls: [River.State.analyze_user_quality] *)

     

       111
       75
        
       

     

       112
       76
        
       (** {2 Main Command} *)

     

       113
       77

stack/river/dune-project

···

       42
       42
        
         (jsonfeed (>= 1.1.0))

     

       43
       43
        
         (jsont (>= 0.2.0))

     

       44
       44
        
         (jsont.bytesrw (>= 0.2.0))

     

       45
       45
       +
         sortal

     

       45
       46
        
         (odoc :with-doc)))

+1 -1

stack/river/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name river)

     

       3
       3
        
        (public_name river)

     

       4
       4
       -
        (libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime jsonfeed jsont jsont.bytesrw xdge cmdliner eiocmd fmt))

     

       4
       4
       +
        (libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime jsonfeed jsont jsont.bytesrw xdge cmdliner eiocmd fmt sortal))

+7 -2

stack/river/lib/feed.ml

···

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

     

       101
       101
        
               body

     

       102
       102
        
           | Error (status, msg) ->

     

       103
       103
       +
               let truncated_msg =

     

       104
       104
       +
                 if String.length msg > 200

     

       105
       105
       +
                 then String.sub msg 0 200 ^ "..."

     

       106
       106
       +
                 else msg

     

       107
       107
       +
               in

     

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

     

       104
       104
       -
                 (Source.name source) status msg);

     

       105
       105
       -
               failwith (Printf.sprintf "HTTP %d: %s" status msg)

     

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

     

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

     

       106
       111
        
         in

     

       107
       112
        
       

     

       108
       113
        
         let content = classify_feed ~xmlbase response in

+35 -40

stack/river/lib/river.mli

···

       237
       237
        
       (** {1 User Management} *)

     

       238
       238
        
       

     

       239
       239
        
       module User : sig

     

       240
       240
       +
         (** River user composed from Sortal contact data + sync state.

     

       241
       241
       +
       

     

       242
       242
       +
             User data is stored in Sortal and read on-demand. River only persists

     

       243
       243
       +
             sync timestamps and optional per-user overrides. *)

     

       244
       244
       +
       

     

       240
       245
        
         type t

     

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

     

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

     

       242
       247
        
       

     

       243
       243
       -
         val make :

     

       244
       244
       -
           username:string ->

     

       245
       245
       -
           fullname:string ->

     

       246
       246
       -
           ?email:string ->

     

       247
       247
       -
           ?feeds:Source.t list ->

     

       248
       248
       -
           ?last_synced:string ->

     

       249
       249
       -
           unit ->

     

       250
       250
       -
           t

     

       251
       251
       -
         (** [make ~username ~fullname ()] creates a new user.

     

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

     

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

     

       252
       250
        
       

     

       253
       253
       -
             @param username Unique username identifier

     

       254
       254
       -
             @param fullname User's display name

     

       255
       255
       -
             @param email Optional email address

     

       256
       256
       -
             @param feeds Optional list of feed sources (default: [])

     

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

     

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

     

       258
       253
        
       

     

       259
       254
        
         val username : t -> string

     

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

     

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

     

       261
       256
        
       

     

       262
       257
        
         val fullname : t -> string

     

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

     

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

     

       264
       259
        
       

     

       265
       260
        
         val email : t -> string option

     

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

     

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

     

       267
       262
        
       

     

       268
       263
        
         val feeds : t -> Source.t list

     

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

     

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

     

       270
       265
        
       

     

       271
       266
        
         val last_synced : t -> string option

     

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

     

       273
       268
        
       

     

       274
       274
       -
         val add_feed : t -> Source.t -> t

     

       275
       275
       -
         (** [add_feed user source] returns a new user with the feed added. *)

     

       276
       276
       -
       

     

       277
       277
       -
         val remove_feed : t -> url:string -> t

     

       278
       278
       -
         (** [remove_feed user ~url] returns a new user with the feed removed by URL. *)

     

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

     

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

     

       279
       271
        
       

     

       280
       272
        
         val set_last_synced : t -> string -> t

     

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

     

       282
       282
       -
       

     

       283
       283
       -
         val jsont : t Jsont.t

     

       284
       284
       -
         (** JSON codec for users. *)

     

       285
       274
        
       end

     

       286
       275
        
       

     

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

     
···

       331
       320
        
       

     

       332
       321
        
       module State : sig

     

       333
       322
        
         type t

     

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

     

       323
       323
       +
         (** State handle for managing sync state and feeds on disk.

     

       324
       324
       +
       

     

       325
       325
       +
             User contact data is read from Sortal on-demand. River only persists

     

       326
       326
       +
             sync timestamps and feed data. *)

     

       335
       327
        
       

     

       336
       328
        
         val create :

     

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

     
···

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

     

       341
       333
        
       

     

       342
       334
        
             Data is stored in:

     

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

     

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

     

       335
       335
       +
             - Sync state: $XDG_STATE_HOME/[app_name]/sync_state.json

     

       336
       336
       +
             - Feeds: $XDG_STATE_HOME/[app_name]/feeds/[username]/

     

       337
       337
       +
       

     

       338
       338
       +
             User contact data is read from Sortal's XDG location.

     

       345
       339
        
       

     

       346
       340
        
             @param env The Eio environment with filesystem access

     

       347
       341
        
             @param app_name Application name for XDG paths *)

     

       348
       342
        
       

     

       349
       343
        
         (** {2 User Operations} *)

     

       350
       344
        
       

     

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

     

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

     

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

     

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

     

       353
       347
        
       

     

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

     

       348
       348
       +
             This reads contact data from Sortal and combines it with River's sync state.

     

       349
       349
       +
             Returns [None] if the username doesn't exist in Sortal or has no feeds. *)

     

       355
       350
        
       

     

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

     

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

     

       351
       351
       +
         val list_users : t -> string list

     

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

     

       358
       353
        
       

     

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

     

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

     

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

     

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

     

       361
       356
        
       

     

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

     

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

     

       357
       357
       +
         val update_sync_state : t -> username:string -> timestamp:string -> (unit, string) result

     

       358
       358
       +
         (** [update_sync_state state ~username ~timestamp] updates the last sync timestamp.

     

       364
       359
        
       

     

       365
       365
       -
         val list_users : t -> string list

     

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

     

       360
       360
       +
             @param username The user to update

     

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

     

       367
       362
        
       

     

       368
       363
        
         (** {2 Feed Operations} *)

     

       369
       364

+89 -83

stack/river/lib/state.ml

···

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

     

       16
       16
        
        *)

     

       17
       17
        
       

     

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

     

       18
       18
       +
       (** State management for sync state and feeds.

     

       19
       19
       +
       

     

       20
       20
       +
           User contact data is read from Sortal on-demand. River only persists

     

       21
       21
       +
           sync timestamps and feed data. *)

     

       19
       22
        
       

     

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

     

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

     

       22
       25
        
       

     

       23
       26
        
       type t = {

     

       24
       27
        
         xdg : Xdge.t;

     

       28
       28
       +
         sortal : Sortal.t;

     

       25
       29
        
       }

     

       26
       30
        
       

     

       27
       31
        
       module Paths = struct

     

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

     

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

     

       30
       30
       -
       

     

       31
       32
        
         (** Get the feeds directory path *)

     

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

     

       33
       34
        
       

     

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

     

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

     

       36
       37
        
       

     

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

     

       38
       38
       -
         let user_file state username =

     

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

     

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

     

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

     

       40
       40
        
       

     

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

     

       42
       42
        
         let user_feed_file state username =

     
···

       45
       45
        
         (** Ensure all necessary directories exist *)

     

       46
       46
        
         let ensure_directories state =

     

       47
       47
        
           let dirs = [

     

       48
       48
       -
             users_dir state;

     

       49
       48
        
             feeds_dir state;

     

       50
       49
        
             user_feeds_dir state;

     

       51
       50
        
           ] in

     
···

       55
       54
        
           ) dirs

     

       56
       55
        
       end

     

       57
       56
        
       

     

       58
       58
       -
       module Json = struct

     

       59
       59
       -
         (** Decode a user from JSON string *)

     

       60
       60
       -
         let user_of_string s =

     

       61
       61
       -
           match Jsont_bytesrw.decode_string' User.jsont s with

     

       62
       62
       -
           | Ok user -> Some user

     

       63
       63
       -
           | Error err ->

     

       64
       64
       -
               Log.err (fun m -> m "Failed to parse user JSON: %s" (Jsont.Error.to_string err));

     

       65
       65
       -
               None

     

       66
       66
       -
       

     

       67
       67
       -
         (** Encode a user to JSON string *)

     

       68
       68
       -
         let user_to_string user =

     

       69
       69
       -
           match Jsont_bytesrw.encode_string' ~format:Jsont.Indent User.jsont user with

     

       70
       70
       -
           | Ok s -> s

     

       71
       71
       -
           | Error err -> failwith ("Failed to encode user: " ^ Jsont.Error.to_string err)

     

       72
       72
       -
       end

     

       57
       57
       +
       (** Sync state management - maps username to last_synced timestamp *)

     

       58
       58
       +
       module Sync_state = struct

     

       59
       59
       +
         let jsont =

     

       60
       60
       +
           let pair_t =

     

       61
       61
       +
             let make username timestamp = (username, timestamp) in

     

       62
       62
       +
             Jsont.Object.map ~kind:"SyncEntry" make

     

       63
       63
       +
             |> Jsont.Object.mem "username" Jsont.string ~enc:fst

     

       64
       64
       +
             |> Jsont.Object.mem "timestamp" Jsont.string ~enc:snd

     

       65
       65
       +
             |> Jsont.Object.finish

     

       66
       66
       +
           in

     

       67
       67
       +
           Jsont.Object.map ~kind:"SyncState" (fun pairs -> pairs)

     

       68
       68
       +
           |> Jsont.Object.mem "synced_users" (Jsont.list pair_t) ~enc:(fun s -> s)

     

       69
       69
       +
           |> Jsont.Object.finish

     

       73
       70
        
       

     

       74
       74
       -
       module Storage = struct

     

       75
       75
       -
         (** Load a user from disk *)

     

       76
       76
       -
         let load_user state username =

     

       77
       77
       -
           let file = Paths.user_file state username in

     

       71
       71
       +
         let load state =

     

       72
       72
       +
           let file = Paths.sync_state_file state in

     

       78
       73
        
           try

     

       79
       74
        
             let content = Eio.Path.load file in

     

       80
       80
       -
             Json.user_of_string content

     

       75
       75
       +
             match Jsont_bytesrw.decode_string' jsont content with

     

       76
       76
       +
             | Ok pairs -> pairs

     

       77
       77
       +
             | Error err ->

     

       78
       78
       +
                 Log.warn (fun m -> m "Failed to parse sync state: %s" (Jsont.Error.to_string err));

     

       79
       79
       +
                 []

     

       81
       80
        
           with

     

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

     

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

     

       83
       82
        
           | e ->

     

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

     

       85
       85
       -
             None

     

       83
       83
       +
               Log.err (fun m -> m "Error loading sync state: %s" (Printexc.to_string e));

     

       84
       84
       +
               []

     

       85
       85
       +
       

     

       86
       86
       +
         let save state sync_state =

     

       87
       87
       +
           let file = Paths.sync_state_file state in

     

       88
       88
       +
           match Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont sync_state with

     

       89
       89
       +
           | Ok json -> Eio.Path.save ~create:(`Or_truncate 0o644) file json

     

       90
       90
       +
           | Error err -> failwith ("Failed to encode sync state: " ^ Jsont.Error.to_string err)

     

       86
       91
        
       

     

       87
       87
       -
         (** Save a user to disk *)

     

       88
       88
       -
         let save_user state user =

     

       89
       89
       -
           let file = Paths.user_file state (User.username user) in

     

       90
       90
       -
           let json = Json.user_to_string user in

     

       91
       91
       -
           Eio.Path.save ~create:(`Or_truncate 0o644) file json

     

       92
       92
       +
         let get_timestamp state username =

     

       93
       93
       +
           load state |> List.assoc_opt username

     

       94
       94
       +
       

     

       95
       95
       +
         let set_timestamp state username timestamp =

     

       96
       96
       +
           let sync_state = load state in

     

       97
       97
       +
           let updated = (username, timestamp) :: List.remove_assoc username sync_state in

     

       98
       98
       +
           save state updated

     

       99
       99
       +
       end

     

       92
       100
        
       

     

       93
       93
       -
         (** List all usernames *)

     

       101
       101
       +
       module Storage = struct

     

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

     

       94
       103
        
         let list_users state =

     

       95
       104
        
           try

     

       96
       96
       -
             Eio.Path.read_dir (Paths.users_dir state)

     

       97
       97
       -
             |> List.filter_map (fun name ->

     

       98
       98
       -
               if Filename.check_suffix name ".json" then

     

       99
       99
       -
                 Some (Filename.chop_suffix name ".json")

     

       100
       100
       -
               else None

     

       101
       101
       -
             )

     

       102
       102
       -
           with _ -> []

     

       105
       105
       +
             Sortal.list state.sortal

     

       106
       106
       +
             |> List.filter (fun contact -> Sortal.Contact.feeds contact <> None)

     

       107
       107
       +
             |> List.map Sortal.Contact.handle

     

       108
       108
       +
           with e ->

     

       109
       109
       +
             Log.err (fun m -> m "Error listing Sortal users: %s" (Printexc.to_string e));

     

       110
       110
       +
             []

     

       111
       111
       +
       

     

       112
       112
       +
         (** Get a user from Sortal with sync state *)

     

       113
       113
       +
         let get_user state username =

     

       114
       114
       +
           match Sortal.lookup state.sortal username with

     

       115
       115
       +
           | None -> None

     

       116
       116
       +
           | Some contact ->

     

       117
       117
       +
               (* Only return users with feeds *)

     

       118
       118
       +
               if Sortal.Contact.feeds contact = None then None

     

       119
       119
       +
               else

     

       120
       120
       +
                 let last_synced = Sync_state.get_timestamp state username in

     

       121
       121
       +
                 Some (User.of_contact contact ?last_synced ())

     

       122
       122
       +
       

     

       123
       123
       +
         (** Get all users from Sortal with sync state *)

     

       124
       124
       +
         let get_all_users state =

     

       125
       125
       +
           try

     

       126
       126
       +
             Sortal.list state.sortal

     

       127
       127
       +
             |> List.filter (fun contact -> Sortal.Contact.feeds contact <> None)

     

       128
       128
       +
             |> List.map (fun contact ->

     

       129
       129
       +
                 let username = Sortal.Contact.handle contact in

     

       130
       130
       +
                 let last_synced = Sync_state.get_timestamp state username in

     

       131
       131
       +
                 User.of_contact contact ?last_synced ())

     

       132
       132
       +
           with e ->

     

       133
       133
       +
             Log.err (fun m -> m "Error getting all users: %s" (Printexc.to_string e));

     

       134
       134
       +
             []

     

       103
       135
        
       

     

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

     

       105
       137
        
         let load_existing_posts state username =

     
···

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

     

       124
       156
        
           let xml = Format.Atom.to_string feed in

     

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

     

       126
       126
       -
       

     

       127
       127
       -
         (** Delete a user and their feed file *)

     

       128
       128
       -
         let delete_user state username =

     

       129
       129
       -
           let user_file = Paths.user_file state username in

     

       130
       130
       -
           let feed_file = Paths.user_feed_file state username in

     

       131
       131
       -
           (try Eio.Path.unlink user_file with _ -> ());

     

       132
       132
       -
           (try Eio.Path.unlink feed_file with _ -> ())

     

       133
       158
        
       end

     

       134
       159
        
       

     

       135
       160
        
       module Sync = struct

     
···

       169
       194
        
       

     

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

     

       171
       196
        
         let sync_user session state ~username =

     

       172
       172
       -
           match Storage.load_user state username with

     

       197
       197
       +
           match Storage.get_user state username with

     

       173
       198
        
           | None ->

     

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

     

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

     
···

       215
       240
        
       

     

       216
       241
        
               (* Update last_synced timestamp *)

     

       217
       242
        
               let now = current_timestamp () in

     

       218
       218
       -
               let user = User.set_last_synced user now in

     

       219
       219
       -
               Storage.save_user state user;

     

       243
       243
       +
               Sync_state.set_timestamp state username now;

     

       220
       244
        
       

     

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

     

       222
       246
        
               Ok ()

     
···

       312
       336
        
       

     

       313
       337
        
       let create env ~app_name =

     

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

     

       315
       315
       -
         let state = { xdg } in

     

       339
       339
       +
         (* Sortal always uses "sortal" as the app name for shared contact database *)

     

       340
       340
       +
         let sortal = Sortal.create env#fs "sortal" in

     

       341
       341
       +
         let state = { xdg; sortal } in

     

       316
       342
        
         Paths.ensure_directories state;

     

       317
       343
        
         state

     

       318
       344
        
       

     

       319
       319
       -
       let create_user state user =

     

       320
       320
       -
         match Storage.load_user state (User.username user) with

     

       321
       321
       -
         | Some _ ->

     

       322
       322
       -
           Error (Printf.sprintf "User %s already exists" (User.username user))

     

       323
       323
       -
         | None ->

     

       324
       324
       -
           Storage.save_user state user;

     

       325
       325
       -
           Log.info (fun m -> m "User %s created" (User.username user));

     

       326
       326
       -
           Ok ()

     

       327
       327
       -
       

     

       328
       328
       -
       let delete_user state ~username =

     

       329
       329
       -
         match Storage.load_user state username with

     

       330
       330
       -
         | None ->

     

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

     

       332
       332
       -
         | Some _ ->

     

       333
       333
       -
           Storage.delete_user state username;

     

       334
       334
       -
           Log.info (fun m -> m "User %s deleted" username);

     

       335
       335
       -
           Ok ()

     

       336
       336
       -
       

     

       337
       345
        
       let get_user state ~username =

     

       338
       338
       -
         Storage.load_user state username

     

       346
       346
       +
         Storage.get_user state username

     

       339
       347
        
       

     

       340
       340
       -
       let update_user state user =

     

       341
       341
       -
         match Storage.load_user state (User.username user) with

     

       342
       342
       -
         | None ->

     

       343
       343
       -
           Error (Printf.sprintf "User %s not found" (User.username user))

     

       344
       344
       -
         | Some _ ->

     

       345
       345
       -
           Storage.save_user state user;

     

       346
       346
       -
           Log.info (fun m -> m "User %s updated" (User.username user));

     

       347
       347
       -
           Ok ()

     

       348
       348
       +
       let get_all_users state =

     

       349
       349
       +
         Storage.get_all_users state

     

       348
       350
        
       

     

       349
       351
        
       let list_users state =

     

       350
       352
        
         Storage.list_users state

     

       353
       353
       +
       

     

       354
       354
       +
       let update_sync_state state ~username ~timestamp =

     

       355
       355
       +
         Sync_state.set_timestamp state username timestamp;

     

       356
       356
       +
         Ok ()

     

       351
       357
        
       

     

       352
       358
        
       let sync_user env state ~username =

     

       353
       359
        
         Session.with_session env @@ fun session ->

     
···

       425
       431
        
             Export.export_jsonfeed ~title entries

     

       426
       432
        
       

     

       427
       433
        
       let analyze_user_quality state ~username =

     

       428
       428
       -
         match Storage.load_user state username with

     

       434
       434
       +
         match Storage.get_user state username with

     

       429
       435
        
         | None ->

     

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

     

       431
       437
        
         | Some _ ->

+21 -15

stack/river/lib/state.mli

···

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

     

       16
       16
        
        *)

     

       17
       17
        
       

     

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

     

       18
       18
       +
       (** State management for sync state and feeds.

     

       19
       19
       +
       

     

       20
       20
       +
           User contact data is read from Sortal on-demand. River only persists

     

       21
       21
       +
           sync timestamps and feed data. *)

     

       19
       22
        
       

     

       20
       23
        
       type t

     

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

     

       24
       24
       +
       (** State handle for managing sync state and feeds on disk. *)

     

       22
       25
        
       

     

       23
       26
        
       val create :

     

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

     
···

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

     

       28
       31
        
       

     

       29
       32
        
           Data is stored in:

     

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

     

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

     

       33
       33
       +
           - Sync state: $XDG_STATE_HOME/[app_name]/sync_state.json

     

       34
       34
       +
           - Feeds: $XDG_STATE_HOME/[app_name]/feeds/[username]/

     

       35
       35
       +
       

     

       36
       36
       +
           User contact data is read from Sortal's XDG location.

     

       32
       37
        
       

     

       33
       38
        
           @param env The Eio environment with filesystem access

     

       34
       39
        
           @param app_name Application name for XDG paths *)

     

       35
       40
        
       

     

       36
       41
        
       (** {2 User Operations} *)

     

       37
       42
        
       

     

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

     

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

     

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

     

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

     

       40
       45
        
       

     

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

     

       46
       46
       +
           This reads contact data from Sortal and combines it with River's sync state.

     

       47
       47
       +
           Returns [None] if the username doesn't exist in Sortal or has no feeds. *)

     

       42
       48
        
       

     

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

     

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

     

       49
       49
       +
       val list_users : t -> string list

     

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

     

       45
       51
        
       

     

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

     

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

     

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

     

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

     

       48
       54
        
       

     

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

     

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

     

       55
       55
       +
       val update_sync_state : t -> username:string -> timestamp:string -> (unit, string) result

     

       56
       56
       +
       (** [update_sync_state state ~username ~timestamp] updates the last sync timestamp.

     

       51
       57
        
       

     

       52
       52
       -
       val list_users : t -> string list

     

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

     

       58
       58
       +
           @param username The user to update

     

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

     

       54
       60
        
       

     

       55
       61
        
       (** {2 Feed Operations} *)

     

       56
       62

+19 -29

stack/river/lib/user.ml

···

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

     

       16
       16
        
        *)

     

       17
       17
        
       

     

       18
       18
       -
       (** User management. *)

     

       18
       18
       +
       (** River user composed from Sortal contact data + sync state. *)

     

       19
       19
        
       

     

       20
       20
        
       type t = {

     

       21
       21
       -
         username : string;

     

       22
       22
       -
         fullname : string;

     

       23
       23
       -
         email : string option;

     

       24
       24
       -
         feeds : Source.t list;

     

       21
       21
       +
         contact : Sortal.Contact.t;

     

       25
       22
        
         last_synced : string option;

     

       26
       23
        
       }

     

       27
       24
        
       

     

       28
       28
       -
       let make ~username ~fullname ?email ?(feeds = []) ?last_synced () =

     

       29
       29
       -
         { username; fullname; email; feeds; last_synced }

     

       25
       25
       +
       let of_contact contact ?last_synced () =

     

       26
       26
       +
         { contact; last_synced }

     

       30
       27
        
       

     

       31
       31
       -
       let username t = t.username

     

       32
       32
       -
       let fullname t = t.fullname

     

       33
       33
       -
       let email t = t.email

     

       34
       34
       -
       let feeds t = t.feeds

     

       28
       28
       +
       let username t = Sortal.Contact.handle t.contact

     

       29
       29
       +
       let fullname t = Sortal.Contact.primary_name t.contact

     

       30
       30
       +
       let email t = Sortal.Contact.email t.contact

     

       31
       31
       +
       let contact t = t.contact

     

       35
       32
        
       let last_synced t = t.last_synced

     

       36
       33
        
       

     

       37
       37
       -
       let add_feed t source =

     

       38
       38
       -
         { t with feeds = source :: t.feeds }

     

       39
       39
       -
       

     

       40
       40
       -
       let remove_feed t ~url =

     

       41
       41
       -
         let feeds = List.filter (fun s -> Source.url s <> url) t.feeds in

     

       42
       42
       -
         { t with feeds }

     

       34
       34
       +
       let feeds t =

     

       35
       35
       +
         match Sortal.Contact.feeds t.contact with

     

       36
       36
       +
         | None -> []

     

       37
       37
       +
         | Some sortal_feeds ->

     

       38
       38
       +
             List.map (fun feed ->

     

       39
       39
       +
               let name = match Sortal.Feed.name feed with

     

       40
       40
       +
                 | Some n -> n

     

       41
       41
       +
                 | None -> Sortal.Contact.primary_name t.contact ^ " feed"

     

       42
       42
       +
               in

     

       43
       43
       +
               Source.make ~name ~url:(Sortal.Feed.url feed)

     

       44
       44
       +
             ) sortal_feeds

     

       43
       45
        
       

     

       44
       46
        
       let set_last_synced t timestamp =

     

       45
       47
        
         { t with last_synced = Some timestamp }

     

       46
       46
       -
       

     

       47
       47
       -
       let jsont =

     

       48
       48
       -
         let make username fullname email feeds last_synced =

     

       49
       49
       -
           { username; fullname; email; feeds; last_synced }

     

       50
       50
       -
         in

     

       51
       51
       -
         Jsont.Object.map ~kind:"User" make

     

       52
       52
       -
         |> Jsont.Object.mem "username" Jsont.string ~enc:(fun u -> u.username)

     

       53
       53
       -
         |> Jsont.Object.mem "fullname" Jsont.string ~enc:(fun u -> u.fullname)

     

       54
       54
       -
         |> Jsont.Object.opt_mem "email" Jsont.string ~enc:(fun u -> u.email)

     

       55
       55
       -
         |> Jsont.Object.mem "feeds" (Jsont.list Source.jsont) ~enc:(fun u -> u.feeds)

     

       56
       56
       -
         |> Jsont.Object.opt_mem "last_synced" Jsont.string ~enc:(fun u -> u.last_synced)

     

       57
       57
       -
         |> Jsont.Object.finish

+14 -27

stack/river/lib/user.mli

···

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

     

       16
       16
        
        *)

     

       17
       17
        
       

     

       18
       18
       -
       (** User management. *)

     

       18
       18
       +
       (** River user composed from Sortal contact data + sync state.

     

       19
       19
       +
       

     

       20
       20
       +
           User data is stored in Sortal and read on-demand. River only persists

     

       21
       21
       +
           sync timestamps and optional per-user overrides. *)

     

       19
       22
        
       

     

       20
       23
        
       type t

     

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

     

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

     

       22
       25
        
       

     

       23
       23
       -
       val make :

     

       24
       24
       -
         username:string ->

     

       25
       25
       -
         fullname:string ->

     

       26
       26
       -
         ?email:string ->

     

       27
       27
       -
         ?feeds:Source.t list ->

     

       28
       28
       -
         ?last_synced:string ->

     

       29
       29
       -
         unit ->

     

       30
       30
       -
         t

     

       31
       31
       -
       (** [make ~username ~fullname ()] creates a new user.

     

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

     

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

     

       32
       28
        
       

     

       33
       33
       -
           @param username Unique username identifier

     

       34
       34
       -
           @param fullname User's display name

     

       35
       35
       -
           @param email Optional email address

     

       36
       36
       -
           @param feeds Optional list of feed sources (default: [])

     

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

     

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

     

       38
       31
        
       

     

       39
       32
        
       val username : t -> string

     

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

     

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

     

       41
       34
        
       

     

       42
       35
        
       val fullname : t -> string

     

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

     

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

     

       44
       37
        
       

     

       45
       38
        
       val email : t -> string option

     

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

     

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

     

       47
       40
        
       

     

       48
       41
        
       val feeds : t -> Source.t list

     

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

     

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

     

       50
       43
        
       

     

       51
       44
        
       val last_synced : t -> string option

     

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

     

       53
       46
        
       

     

       54
       54
       -
       val add_feed : t -> Source.t -> t

     

       55
       55
       -
       (** [add_feed user source] returns a new user with the feed added. *)

     

       56
       56
       -
       

     

       57
       57
       -
       val remove_feed : t -> url:string -> t

     

       58
       58
       -
       (** [remove_feed user ~url] returns a new user with the feed removed by URL. *)

     

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

     

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

     

       59
       49
        
       

     

       60
       50
        
       val set_last_synced : t -> string -> t

     

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

     

       62
       62
       -
       

     

       63
       63
       -
       val jsont : t Jsont.t

     

       64
       64
       -
       (** JSON codec for users. *)

stack/river/river.opam

···

       27
       27
        
         "jsonfeed" {>= "1.1.0"}

     

       28
       28
        
         "jsont" {>= "0.2.0"}

     

       29
       29
        
         "jsont.bytesrw" {>= "0.2.0"}

     

       30
       30
       +
         "sortal"

     

       30
       31
        
         "odoc" {with-doc}

     

       31
       32
        
       ]

     

       32
       33
        
       build: [