commit ff1b1e13fdf765012729ceb74661431825a488e5 · anil.recoil.org/slop

+90 -1

stack/river/bin/river_cli.ml

···

       654
       654
        
             Post.list state ~username_opt ~limit

     

       655
       655
        
           ) $ username_opt_arg $ limit_arg)

     

       656
       656
        
       

     

       657
       657
       +
       (* Info command - show detailed post information *)

     

       658
       658
       +
       let info_cmd =

     

       659
       659
       +
         let doc = "Display detailed information about a post by ID" in

     

       660
       660
       +
         let id_arg =

     

       661
       661
       +
           let doc = "Post ID or partial ID to search for" in

     

       662
       662
       +
           Arg.(required & pos 0 (some string) None & info [] ~docv:"ID" ~doc)

     

       663
       663
       +
         in

     

       664
       664
       +
         let verbose_flag =

     

       665
       665
       +
           let doc = "Show full content and all metadata" in

     

       666
       666
       +
           Arg.(value & flag & info ["v"; "verbose"] ~doc)

     

       667
       667
       +
         in

     

       668
       668
       +
         Eiocmd.run

     

       669
       669
       +
           ~use_keyeio:false

     

       670
       670
       +
           ~info:(Cmd.info "info" ~doc)

     

       671
       671
       +
           ~app_name:"river"

     

       672
       672
       +
           ~service:"river"

     

       673
       673
       +
           Term.(const (fun id verbose _env xdg _profile ->

     

       674
       674
       +
             let store = River_store.create_with_xdge xdg in

     

       675
       675
       +
       

     

       676
       676
       +
             match River_store.find_entry_by_id store ~id with

     

       677
       677
       +
             | None ->

     

       678
       678
       +
                 Fmt.pr "%a@." Fmt.(styled `Red string) (Printf.sprintf "No post found with ID: %s" id);

     

       679
       679
       +
                 1

     

       680
       680
       +
             | Some entry ->

     

       681
       681
       +
                 (* Print header *)

     

       682
       682
       +
                 Fmt.pr "@.";

     

       683
       683
       +
                 Fmt.pr "%a@." Fmt.(styled `Bold string)

     

       684
       684
       +
                   (String.make 70 '=');

     

       685
       685
       +
                 Fmt.pr "  %a@." Fmt.(styled `Bold (styled (`Fg `Blue) string)) entry.title;

     

       686
       686
       +
                 Fmt.pr "%a@.@." Fmt.(styled `Bold string)

     

       687
       687
       +
                   (String.make 70 '=');

     

       688
       688
       +
       

     

       689
       689
       +
                 (* Basic metadata *)

     

       690
       690
       +
                 Fmt.pr "%a %s@." Fmt.(styled `Cyan string) "ID:       " entry.atom_id;

     

       691
       691
       +
       

     

       692
       692
       +
                 (match entry.link with

     

       693
       693
       +
                  | Some url ->

     

       694
       694
       +
                      Fmt.pr "%a %s@." Fmt.(styled `Cyan string) "URL:      " (Uri.to_string url)

     

       695
       695
       +
                  | None -> ());

     

       696
       696
       +
       

     

       697
       697
       +
                 Fmt.pr "%a %s@." Fmt.(styled `Cyan string) "Feed:     " entry.feed_name;

     

       698
       698
       +
                 Fmt.pr "%a %s@." Fmt.(styled `Faint string) "          " ("(" ^ entry.feed_url ^ ")");

     

       699
       699
       +
       

     

       700
       700
       +
                 Fmt.pr "%a %s" Fmt.(styled `Cyan string) "Author:   " entry.author_name;

     

       701
       701
       +
                 (match entry.author_email with

     

       702
       702
       +
                  | Some email -> Fmt.pr " <%s>" email

     

       703
       703
       +
                  | None -> ());

     

       704
       704
       +
                 Fmt.pr "@.";

     

       705
       705
       +
       

     

       706
       706
       +
                 (match entry.published with

     

       707
       707
       +
                  | Some date ->

     

       708
       708
       +
                      Fmt.pr "%a %s@." Fmt.(styled `Cyan string) "Published:" (Ptime.to_rfc3339 date)

     

       709
       709
       +
                  | None -> ());

     

       710
       710
       +
       

     

       711
       711
       +
                 Fmt.pr "%a %s@." Fmt.(styled `Cyan string) "Stored:   " (Ptime.to_rfc3339 entry.stored_at);

     

       712
       712
       +
       

     

       713
       713
       +
                 (* Tags *)

     

       714
       714
       +
                 (match entry.tags with

     

       715
       715
       +
                  | [] -> ()

     

       716
       716
       +
                  | tags ->

     

       717
       717
       +
                      Fmt.pr "%a %s@." Fmt.(styled `Cyan string) "Tags:     " (String.concat ", " tags));

     

       718
       718
       +
       

     

       719
       719
       +
                 (* Summary *)

     

       720
       720
       +
                 (match entry.summary with

     

       721
       721
       +
                  | Some summary ->

     

       722
       722
       +
                      Fmt.pr "@.%a@." Fmt.(styled (`Fg `Yellow) string) "Summary:";

     

       723
       723
       +
                      Fmt.pr "  %s@." summary

     

       724
       724
       +
                  | None -> ());

     

       725
       725
       +
       

     

       726
       726
       +
                 (* Content *)

     

       727
       727
       +
                 Fmt.pr "@.%a@." Fmt.(styled (`Fg `Green) string) "Content:";

     

       728
       728
       +
                 if verbose then

     

       729
       729
       +
                   Fmt.pr "%s@." entry.content

     

       730
       730
       +
                 else begin

     

       731
       731
       +
                   let preview =

     

       732
       732
       +
                     if String.length entry.content > 500 then

     

       733
       733
       +
                       String.sub entry.content 0 500 ^ "..."

     

       734
       734
       +
                     else

     

       735
       735
       +
                       entry.content

     

       736
       736
       +
                   in

     

       737
       737
       +
                   Fmt.pr "%s@." preview;

     

       738
       738
       +
                   if String.length entry.content > 500 then

     

       739
       739
       +
                     Fmt.pr "@.%a@." Fmt.(styled `Faint string) "(Use --verbose to see full content)"

     

       740
       740
       +
                 end;

     

       741
       741
       +
       

     

       742
       742
       +
                 Fmt.pr "@.";

     

       743
       743
       +
                 0

     

       744
       744
       +
           ) $ id_arg $ verbose_flag)

     

       745
       745
       +
       

     

       657
       746
        
       let main_cmd =

     

       658
       747
        
         let doc = "River feed management CLI" in

     

       659
       748
        
         let info = Cmd.info "river-cli" ~version:"1.0" ~doc in

     

       660
       660
       -
         Cmd.group info [user_cmd; sync_cmd; list_cmd]

     

       749
       749
       +
         Cmd.group info [user_cmd; sync_cmd; list_cmd; info_cmd]

     

       661
       750
        
       

     

       662
       751
        
       let () = exit (Cmd.eval' main_cmd)

+6 -3

stack/river/dune-project

···

       17
       17
        
       

     

       18
       18
        
       (package

     

       19
       19
        
        (name river)

     

       20
       20
       -
        (synopsis "RSS2 and Atom feed aggregator for OCaml")

     

       21
       21
       -
        (description "RSS2 and Atom feed aggregator for OCaml")

     

       20
       20
       +
        (synopsis "RSS2, Atom and JSON Feed aggregator for OCaml")

     

       21
       21
       +
        (description "RSS2, Atom and JSON Feed aggregator for OCaml")

     

       22
       22
        
        (depends

     

       23
       23
        
         (ocaml

     

       24
       24
       -
          (>= 4.08.0))

     

       24
       24
       +
          (>= 5.2.0))

     

       25
       25
        
         dune

     

       26
       26
        
         (syndic

     

       27
       27
        
          (>= 1.5))

     
···

       40
       40
        
         yojson

     

       41
       41
        
         fmt

     

       42
       42
        
         xdge

     

       43
       43
       +
         (jsonfeed (>= 1.1.0))

     

       44
       44
       +
         (jsont (>= 0.2.0))

     

       45
       45
       +
         bytesrw

     

       43
       46
        
         (odoc :with-doc)))

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

     

       4
       4
       +
        (wrapped false)

     

       5
       5
       +
        (libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime jsonfeed jsont bytesrw))

+48 -26

stack/river/lib/feed.ml

···

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

     

       20
       20
        
       

     

       21
       21
        
       type source = { name : string; url : string }

     

       22
       22
       -
       type content = Atom of Syndic.Atom.feed | Rss2 of Syndic.Rss2.channel

     

       22
       22
       +
       type content = Atom of Syndic.Atom.feed | Rss2 of Syndic.Rss2.channel | Json of Jsonfeed.t

     

       23
       23
        
       

     

       24
       24
       -
       let string_of_feed = function Atom _ -> "Atom" | Rss2 _ -> "Rss2"

     

       24
       24
       +
       let string_of_feed = function Atom _ -> "Atom" | Rss2 _ -> "Rss2" | Json _ -> "JSONFeed"

     

       25
       25
        
       

     

       26
       26
        
       type t = { name : string; title : string; url : string; content : content }

     

       27
       27
        
       

     

       28
       28
       -
       let classify_feed ~xmlbase (xml : string) =

     

       29
       29
       -
         Log.debug (fun m -> m "Attempting to parse feed (%d bytes)" (String.length xml));

     

       28
       28
       +
       let classify_feed ~xmlbase (body : string) =

     

       29
       29
       +
         Log.debug (fun m -> m "Attempting to parse feed (%d bytes)" (String.length body));

     

       30
       30
       +
       

     

       31
       31
       +
         (* Quick check - does it look like JSON? *)

     

       32
       32
       +
         let looks_like_json =

     

       33
       33
       +
           String.length body > 0 &&

     

       34
       34
       +
           let first_char = String.get body 0 in

     

       35
       35
       +
           first_char = '{' || first_char = '['

     

       36
       36
       +
         in

     

       30
       37
        
       

     

       31
       31
       -
         try

     

       32
       32
       -
           let feed = Atom (Syndic.Atom.parse ~xmlbase (Xmlm.make_input (`String (0, xml)))) in

     

       33
       33
       -
           Log.debug (fun m -> m "Successfully parsed as Atom feed");

     

       34
       34
       -
           feed

     

       35
       35
       -
         with

     

       36
       36
       -
         | Syndic.Atom.Error.Error (pos, msg) -> (

     

       37
       37
       -
           Log.debug (fun m -> m "Not an Atom feed: %s at position (%d, %d)"

     

       38
       38
       -
             msg (fst pos) (snd pos));

     

       38
       38
       +
         if looks_like_json then (

     

       39
       39
       +
           (* Try JSONFeed first *)

     

       40
       40
       +
           Log.debug (fun m -> m "Body looks like JSON, trying JSONFeed parser");

     

       41
       41
       +
           match Jsonfeed.of_string body with

     

       42
       42
       +
           | Ok jsonfeed ->

     

       43
       43
       +
               Log.debug (fun m -> m "Successfully parsed as JSONFeed");

     

       44
       44
       +
               Json jsonfeed

     

       45
       45
       +
           | Error err ->

     

       46
       46
       +
               Log.debug (fun m -> m "Not a JSONFeed: %s" (Jsont.Error.to_string err));

     

       47
       47
       +
               (* Fall through to XML parsing *)

     

       48
       48
       +
               failwith "Not a valid JSONFeed"

     

       49
       49
       +
         ) else (

     

       50
       50
       +
           (* Try XML formats *)

     

       39
       51
        
           try

     

       40
       40
       -
             let feed = Rss2 (Syndic.Rss2.parse ~xmlbase (Xmlm.make_input (`String (0, xml)))) in

     

       41
       41
       -
             Log.debug (fun m -> m "Successfully parsed as RSS2 feed");

     

       52
       52
       +
             let feed = Atom (Syndic.Atom.parse ~xmlbase (Xmlm.make_input (`String (0, body)))) in

     

       53
       53
       +
             Log.debug (fun m -> m "Successfully parsed as Atom feed");

     

       42
       54
        
             feed

     

       43
       43
       -
           with Syndic.Rss2.Error.Error (pos, msg) ->

     

       44
       44
       -
             Log.err (fun m -> m "Failed to parse as RSS2: %s at position (%d, %d)"

     

       55
       55
       +
           with

     

       56
       56
       +
           | Syndic.Atom.Error.Error (pos, msg) -> (

     

       57
       57
       +
             Log.debug (fun m -> m "Not an Atom feed: %s at position (%d, %d)"

     

       45
       58
        
               msg (fst pos) (snd pos));

     

       46
       46
       -
             failwith "Neither Atom nor RSS2 feed")

     

       47
       47
       -
         | Not_found as e ->

     

       48
       48
       -
             Log.err (fun m -> m "Not_found exception during Atom feed parsing");

     

       49
       49
       -
             Log.err (fun m -> m "Backtrace:\n%s" (Printexc.get_backtrace ()));

     

       50
       50
       -
             raise e

     

       51
       51
       -
         | e ->

     

       52
       52
       -
             Log.err (fun m -> m "Unexpected exception during feed parsing: %s"

     

       53
       53
       -
               (Printexc.to_string e));

     

       54
       54
       -
             Log.err (fun m -> m "Backtrace:\n%s" (Printexc.get_backtrace ()));

     

       55
       55
       -
             raise e

     

       59
       59
       +
             try

     

       60
       60
       +
               let feed = Rss2 (Syndic.Rss2.parse ~xmlbase (Xmlm.make_input (`String (0, body)))) in

     

       61
       61
       +
               Log.debug (fun m -> m "Successfully parsed as RSS2 feed");

     

       62
       62
       +
               feed

     

       63
       63
       +
             with Syndic.Rss2.Error.Error (pos, msg) ->

     

       64
       64
       +
               Log.err (fun m -> m "Failed to parse as RSS2: %s at position (%d, %d)"

     

       65
       65
       +
                 msg (fst pos) (snd pos));

     

       66
       66
       +
               failwith "Neither Atom nor RSS2 feed")

     

       67
       67
       +
           | Not_found as e ->

     

       68
       68
       +
               Log.err (fun m -> m "Not_found exception during Atom feed parsing");

     

       69
       69
       +
               Log.err (fun m -> m "Backtrace:\n%s" (Printexc.get_backtrace ()));

     

       70
       70
       +
               raise e

     

       71
       71
       +
           | e ->

     

       72
       72
       +
               Log.err (fun m -> m "Unexpected exception during feed parsing: %s"

     

       73
       73
       +
                 (Printexc.to_string e));

     

       74
       74
       +
               Log.err (fun m -> m "Backtrace:\n%s" (Printexc.get_backtrace ()));

     

       75
       75
       +
               raise e

     

       76
       76
       +
         )

     

       56
       77
        
       

     

       57
       78
        
       let fetch client (source : source) =

     

       58
       79
        
         Log.info (fun m -> m "Fetching feed '%s' from %s" source.name source.url);

     
···

       76
       97
        
           match content with

     

       77
       98
        
           | Atom atom -> Util.string_of_text_construct atom.Syndic.Atom.title

     

       78
       99
        
           | Rss2 ch -> ch.Syndic.Rss2.title

     

       100
       100
       +
           | Json jsonfeed -> Jsonfeed.title jsonfeed

     

       79
       101
        
         in

     

       80
       102
        
       

     

       81
       103
        
         Log.info (fun m -> m "Successfully fetched %s feed '%s' (title: '%s')"

+172 -3

stack/river/lib/post.ml

···

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

     

       20
       20
        
       

     

       21
       21
        
       type t = {

     

       22
       22
       +
         id : string;

     

       22
       23
        
         title : string;

     

       23
       24
        
         link : Uri.t option;

     

       24
       25
        
         date : Syndic.Date.t option;

     
···

       27
       28
        
         email : string;

     

       28
       29
        
         content : Soup.soup Soup.node;

     

       29
       30
        
         mutable link_response : (string, string) result option;

     

       31
       31
       +
         tags : string list;

     

       32
       32
       +
         summary : string option;

     

       30
       33
        
       }

     

       34
       34
       +
       

     

       35
       35
       +
       (** Generate a stable, unique ID from available data *)

     

       36
       36
       +
       let generate_id ?guid ?link ?title ?date ~feed_url () =

     

       37
       37
       +
         match guid with

     

       38
       38
       +
         | Some id when id <> "" ->

     

       39
       39
       +
             (* Use explicit ID/GUID if available *)

     

       40
       40
       +
             id

     

       41
       41
       +
         | _ ->

     

       42
       42
       +
             match link with

     

       43
       43
       +
             | Some uri when Uri.to_string uri <> "" ->

     

       44
       44
       +
                 (* Use permalink as ID (stable and unique) *)

     

       45
       45
       +
                 Uri.to_string uri

     

       46
       46
       +
             | _ ->

     

       47
       47
       +
                 (* Fallback: hash of feed_url + title + date *)

     

       48
       48
       +
                 let title_str = Option.value title ~default:"" in

     

       49
       49
       +
                 let date_str =

     

       50
       50
       +
                   match date with

     

       51
       51
       +
                   | Some d -> Ptime.to_rfc3339 d

     

       52
       52
       +
                   | None -> ""

     

       53
       53
       +
                 in

     

       54
       54
       +
                 let composite = Printf.sprintf "%s|%s|%s" feed_url title_str date_str in

     

       55
       55
       +
                 (* Use SHA256 for stable hashing *)

     

       56
       56
       +
                 Digest.string composite |> Digest.to_hex

     

       57
       57
       +
       

     

       58
       58
       +
       let post_id post = post.id

     

       31
       59
        
       

     

       32
       60
        
       let resolve_links_attr ~xmlbase attr el =

     

       33
       61
        
         Soup.R.attribute attr el

     
···

       141
       169
        
                 | _ ->

     

       142
       170
        
                     (* Use feed title *)

     

       143
       171
        
                     Util.string_of_text_construct atom_feed.Syndic.Atom.title)

     

       144
       144
       -
             | Feed.Rss2 _ ->

     

       145
       145
       -
                 (* For RSS2, use the feed name which is the source name *)

     

       172
       172
       +
             | Feed.Rss2 _ | Feed.Json _ ->

     

       173
       173
       +
                 (* For RSS2 and JSONFeed, use the feed name which is the source name *)

     

       146
       174
        
                 feed.name)

     

       147
       175
        
         in

     

       176
       176
       +
         (* Extract tags from Atom categories *)

     

       177
       177
       +
         let tags =

     

       178
       178
       +
           List.map (fun cat -> cat.Syndic.Atom.term) e.categories

     

       179
       179
       +
         in

     

       180
       180
       +
         (* Extract summary - convert from text_construct to string *)

     

       181
       181
       +
         let summary =

     

       182
       182
       +
           match e.summary with

     

       183
       183
       +
           | Some s -> Some (Util.string_of_text_construct s)

     

       184
       184
       +
           | None -> None

     

       185
       185
       +
         in

     

       186
       186
       +
         (* Generate unique ID *)

     

       187
       187
       +
         let guid = Uri.to_string e.id in

     

       188
       188
       +
         let title_str = Util.string_of_text_construct e.title in

     

       189
       189
       +
         let id =

     

       190
       190
       +
           generate_id ~guid ?link ~title:title_str ?date ~feed_url:feed.url ()

     

       191
       191
       +
         in

     

       148
       192
        
         {

     

       149
       149
       -
           title = Util.string_of_text_construct e.title;

     

       193
       193
       +
           id;

     

       194
       194
       +
           title = title_str;

     

       150
       195
        
           link;

     

       151
       196
        
           date;

     

       152
       197
        
           feed;

     
···

       154
       199
        
           email = "";

     

       155
       200
        
           content;

     

       156
       201
        
           link_response = None;

     

       202
       202
       +
           tags;

     

       203
       203
       +
           summary;

     

       157
       204
        
         }

     

       158
       205
        
       

     

       159
       206
        
       let post_of_rss2 ~(feed : Feed.t) it =

     
···

       173
       220
        
                 | _, "" -> html_of_text ?xmlbase d

     

       174
       221
        
                 | xmlbase, c -> html_of_text ?xmlbase c ))

     

       175
       222
        
         in

     

       223
       223
       +
         (* Note: it.link is of type Uri.t option in Syndic *)

     

       176
       224
        
         let link =

     

       177
       225
        
           match (it.guid, it.link) with

     

       178
       226
        
           | Some u, _ when u.permalink -> Some u.data

     
···

       183
       231
        
               Some u.data

     

       184
       232
        
           | None, None -> None

     

       185
       233
        
         in

     

       234
       234
       +
         (* Extract GUID string for ID generation *)

     

       235
       235
       +
         let guid_str =

     

       236
       236
       +
           match it.guid with

     

       237
       237
       +
           | Some u -> Some (Uri.to_string u.data)

     

       238
       238
       +
           | None -> None

     

       239
       239
       +
         in

     

       240
       240
       +
         (* RSS2 doesn't have a categories field exposed, use empty list *)

     

       241
       241
       +
         let tags = [] in

     

       242
       242
       +
         (* RSS2 doesn't have a separate summary field, so leave it empty *)

     

       243
       243
       +
         let summary = None in

     

       244
       244
       +
         (* Generate unique ID *)

     

       245
       245
       +
         let id =

     

       246
       246
       +
           generate_id ?guid:guid_str ?link ~title ?date:it.pubDate ~feed_url:feed.url ()

     

       247
       247
       +
         in

     

       186
       248
        
         {

     

       249
       249
       +
           id;

     

       187
       250
        
           title;

     

       188
       251
        
           link;

     

       189
       252
        
           feed;

     
···

       192
       255
        
           content;

     

       193
       256
        
           date = it.pubDate;

     

       194
       257
        
           link_response = None;

     

       258
       258
       +
           tags;

     

       259
       259
       +
           summary;

     

       260
       260
       +
         }

     

       261
       261
       +
       

     

       262
       262
       +
       let post_of_jsonfeed_item ~(feed : Feed.t) (item : Jsonfeed.Item.t) =

     

       263
       263
       +
         Log.debug (fun m -> m "Processing JSONFeed item: %s"

     

       264
       264
       +
           (Option.value (Jsonfeed.Item.title item) ~default:"Untitled"));

     

       265
       265
       +
       

     

       266
       266
       +
         (* Extract content - prefer HTML, fall back to text *)

     

       267
       267
       +
         let content =

     

       268
       268
       +
           match Jsonfeed.Item.content item with

     

       269
       269
       +
           | `Html html -> html_of_text html

     

       270
       270
       +
           | `Text text -> html_of_text text

     

       271
       271
       +
           | `Both (html, _text) -> html_of_text html

     

       272
       272
       +
         in

     

       273
       273
       +
       

     

       274
       274
       +
         (* Extract author - use first author if multiple *)

     

       275
       275
       +
         let author_name, author_email =

     

       276
       276
       +
           match Jsonfeed.Item.authors item with

     

       277
       277
       +
           | Some (first :: _) ->

     

       278
       278
       +
               let name = Jsonfeed.Author.name first |> Option.value ~default:"" in

     

       279
       279
       +
               (* JSONFeed authors don't typically have email *)

     

       280
       280
       +
               (name, "")

     

       281
       281
       +
           | _ ->

     

       282
       282
       +
               (* Fall back to feed-level authors or feed title *)

     

       283
       283
       +
               (match feed.content with

     

       284
       284
       +
                | Feed.Json jsonfeed ->

     

       285
       285
       +
                    (match Jsonfeed.authors jsonfeed with

     

       286
       286
       +
                     | Some (first :: _) ->

     

       287
       287
       +
                         let name = Jsonfeed.Author.name first |> Option.value ~default:feed.title in

     

       288
       288
       +
                         (name, "")

     

       289
       289
       +
                     | _ -> (feed.title, ""))

     

       290
       290
       +
                | _ -> (feed.title, ""))

     

       291
       291
       +
         in

     

       292
       292
       +
       

     

       293
       293
       +
         (* Link - use url field *)

     

       294
       294
       +
         let link =

     

       295
       295
       +
           Jsonfeed.Item.url item

     

       296
       296
       +
           |> Option.map Uri.of_string

     

       297
       297
       +
         in

     

       298
       298
       +
       

     

       299
       299
       +
         (* Date *)

     

       300
       300
       +
         let date = Jsonfeed.Item.date_published item in

     

       301
       301
       +
       

     

       302
       302
       +
         (* Summary *)

     

       303
       303
       +
         let summary = Jsonfeed.Item.summary item in

     

       304
       304
       +
       

     

       305
       305
       +
         (* Tags *)

     

       306
       306
       +
         let tags =

     

       307
       307
       +
           Jsonfeed.Item.tags item

     

       308
       308
       +
           |> Option.value ~default:[]

     

       309
       309
       +
         in

     

       310
       310
       +
       

     

       311
       311
       +
         (* Generate unique ID - JSONFeed items always have an id field (required) *)

     

       312
       312
       +
         let guid = Jsonfeed.Item.id item in

     

       313
       313
       +
         let title_str = Jsonfeed.Item.title item |> Option.value ~default:"Untitled" in

     

       314
       314
       +
         let id =

     

       315
       315
       +
           generate_id ~guid ?link ~title:title_str ?date ~feed_url:feed.url ()

     

       316
       316
       +
         in

     

       317
       317
       +
       

     

       318
       318
       +
         {

     

       319
       319
       +
           id;

     

       320
       320
       +
           title = title_str;

     

       321
       321
       +
           link;

     

       322
       322
       +
           date;

     

       323
       323
       +
           feed;

     

       324
       324
       +
           author = author_name;

     

       325
       325
       +
           email = author_email;

     

       326
       326
       +
           content;

     

       327
       327
       +
           link_response = None;

     

       328
       328
       +
           tags;

     

       329
       329
       +
           summary;

     

       195
       330
        
         }

     

       196
       331
        
       

     

       197
       332
        
       let posts_of_feed c =

     
···

       204
       339
        
         | Feed.Rss2 ch ->

     

       205
       340
        
             let posts = List.map (post_of_rss2 ~feed:c) ch.Syndic.Rss2.items in

     

       206
       341
        
             Log.debug (fun m -> m "Extracted %d posts from RSS2 feed '%s'"

     

       342
       342
       +
               (List.length posts) c.Feed.name);

     

       343
       343
       +
             posts

     

       344
       344
       +
         | Feed.Json jsonfeed ->

     

       345
       345
       +
             let items = Jsonfeed.items jsonfeed in

     

       346
       346
       +
             let posts = List.map (post_of_jsonfeed_item ~feed:c) items in

     

       347
       347
       +
             Log.debug (fun m -> m "Extracted %d posts from JSONFeed '%s'"

     

       207
       348
        
               (List.length posts) c.Feed.name);

     

       208
       349
        
             posts

     

       209
       350
        
       

     
···

       236
       377
        
           ()

     

       237
       378
        
       

     

       238
       379
        
       let mk_entries posts = List.map mk_entry posts

     

       380
       380
       +
       

     

       381
       381
       +
       let mk_jsonfeed_item post =

     

       382
       382
       +
         (* Convert HTML content back to string *)

     

       383
       383
       +
         let html = Soup.to_string post.content in

     

       384
       384
       +
         let content = `Html html in

     

       385
       385
       +
       

     

       386
       386
       +
         (* Create author *)

     

       387
       387
       +
         let authors =

     

       388
       388
       +
           if post.author <> "" then

     

       389
       389
       +
             let author = Jsonfeed.Author.create ~name:post.author () in

     

       390
       390
       +
             Some [author]

     

       391
       391
       +
           else

     

       392
       392
       +
             None

     

       393
       393
       +
         in

     

       394
       394
       +
       

     

       395
       395
       +
         (* Create item *)

     

       396
       396
       +
         Jsonfeed.Item.create

     

       397
       397
       +
           ~id:post.id

     

       398
       398
       +
           ~content

     

       399
       399
       +
           ?url:(Option.map Uri.to_string post.link)

     

       400
       400
       +
           ~title:post.title

     

       401
       401
       +
           ?summary:post.summary

     

       402
       402
       +
           ?date_published:post.date

     

       403
       403
       +
           ?authors

     

       404
       404
       +
           ~tags:post.tags

     

       405
       405
       +
           ()

     

       406
       406
       +
       

     

       407
       407
       +
       let mk_jsonfeed_items posts = List.map mk_jsonfeed_item posts

     

       239
       408
        
       

     

       240
       409
        
       let get_posts ?n ?(ofs = 0) planet_feeds =

     

       241
       410
        
         Log.info (fun m -> m "Processing %d feeds for posts" (List.length planet_feeds));

+30 -1

stack/river/lib/river.ml

···

       58
       58
        
       let author post = post.Post.author

     

       59
       59
        
       let email post = post.Post.email

     

       60
       60
        
       let content post = Soup.to_string post.Post.content

     

       61
       61
       +
       let id post = post.Post.id

     

       62
       62
       +
       let tags post = post.Post.tags

     

       63
       63
       +
       let summary post = post.Post.summary

     

       61
       64
        
       

     

       62
       65
        
       let meta_description _post =

     

       63
       66
        
         (* TODO: This requires environment for HTTP access *)

     
···

       71
       74
        
       

     

       72
       75
        
       let create_atom_entries posts =

     

       73
       76
        
         Log.info (fun m -> m "Creating Atom entries for %d posts" (List.length posts));

     

       74
       74
       -
         Post.mk_entries posts
     

       77
       77
       +
         Post.mk_entries posts

     

       78
       78
       +
       

     

       79
       79
       +
       (* JSONFeed support *)

     

       80
       80
       +
       let create_jsonfeed_items posts =

     

       81
       81
       +
         Log.info (fun m -> m "Creating JSONFeed items for %d posts" (List.length posts));

     

       82
       82
       +
         Post.mk_jsonfeed_items posts

     

       83
       83
       +
       

     

       84
       84
       +
       let create_jsonfeed ~title ?home_page_url ?feed_url ?description ?icon ?favicon posts =

     

       85
       85
       +
         Log.info (fun m -> m "Creating JSONFeed with %d posts" (List.length posts));

     

       86
       86
       +
         let items = create_jsonfeed_items posts in

     

       87
       87
       +
         Jsonfeed.create ~title ?home_page_url ?feed_url ?description ?icon ?favicon ~items ()

     

       88
       88
       +
       

     

       89
       89
       +
       let jsonfeed_to_string ?(minify = false) jsonfeed =

     

       90
       90
       +
         match Jsonfeed.to_string ~minify jsonfeed with

     

       91
       91
       +
         | Ok s -> Ok s

     

       92
       92
       +
         | Error err -> Error (Jsont.Error.to_string err)

     

       93
       93
       +
       

     

       94
       94
       +
       type feed_content =

     

       95
       95
       +
         | Atom of Syndic.Atom.feed

     

       96
       96
       +
         | Rss2 of Syndic.Rss2.channel

     

       97
       97
       +
         | JSONFeed of Jsonfeed.t

     

       98
       98
       +
       

     

       99
       99
       +
       let feed_content feed =

     

       100
       100
       +
         match feed.Feed.content with

     

       101
       101
       +
         | Feed.Atom f -> Atom f

     

       102
       102
       +
         | Feed.Rss2 ch -> Rss2 ch

     

       103
       103
       +
         | Feed.Json jf -> JSONFeed jf

+47 -1

stack/river/lib/river.mli

···

       59
       59
        
       (** The source of a feed. *)

     

       60
       60
        
       

     

       61
       61
        
       type feed

     

       62
       62
       -
       (** An Atom or RSS feed. *)

     

       62
       62
       +
       (** An Atom, RSS2, or JSON Feed. *)

     

       63
       63
        
       

     

       64
       64
        
       type post

     

       65
       65
        
       (** A post from a feed. *)

     
···

       100
       100
        
       val content : post -> string

     

       101
       101
        
       (** [content post] is the content of the post. *)

     

       102
       102
        
       

     

       103
       103
       +
       val id : post -> string

     

       104
       104
       +
       (** [id post] is the unique identifier of the post. *)

     

       105
       105
       +
       

     

       106
       106
       +
       val tags : post -> string list

     

       107
       107
       +
       (** [tags post] is the list of tags associated with the post. *)

     

       108
       108
       +
       

     

       109
       109
       +
       val summary : post -> string option

     

       110
       110
       +
       (** [summary post] is the summary/excerpt of the post, if available. *)

     

       111
       111
       +
       

     

       103
       112
        
       val meta_description : post -> string option

     

       104
       113
        
       (** [meta_description post] is the meta description of the post on the origin

     

       105
       114
        
           site.

     
···

       117
       126
        
       val create_atom_entries : post list -> Syndic.Atom.entry list

     

       118
       127
        
       (** [create_atom_feed posts] creates a list of atom entries, which can then be

     

       119
       128
        
           used to create an atom feed that is an aggregate of the posts. *)

     

       129
       129
       +
       

     

       130
       130
       +
       (** {1 JSON Feed Support} *)

     

       131
       131
       +
       

     

       132
       132
       +
       val create_jsonfeed_items : post list -> Jsonfeed.Item.t list

     

       133
       133
       +
       (** [create_jsonfeed_items posts] creates a list of JSONFeed items from posts. *)

     

       134
       134
       +
       

     

       135
       135
       +
       val create_jsonfeed :

     

       136
       136
       +
         title:string ->

     

       137
       137
       +
         ?home_page_url:string ->

     

       138
       138
       +
         ?feed_url:string ->

     

       139
       139
       +
         ?description:string ->

     

       140
       140
       +
         ?icon:string ->

     

       141
       141
       +
         ?favicon:string ->

     

       142
       142
       +
         post list ->

     

       143
       143
       +
         Jsonfeed.t

     

       144
       144
       +
       (** [create_jsonfeed ~title ?home_page_url ?feed_url ?description posts]

     

       145
       145
       +
           creates a complete JSONFeed from the given posts.

     

       146
       146
       +
       

     

       147
       147
       +
           @param title The feed title (required)

     

       148
       148
       +
           @param home_page_url The URL of the website the feed represents

     

       149
       149
       +
           @param feed_url The URL of the feed itself

     

       150
       150
       +
           @param description A description of the feed

     

       151
       151
       +
           @param icon URL of an icon for the feed (512x512 recommended)

     

       152
       152
       +
           @param favicon URL of a favicon for the feed (64x64 recommended)

     

       153
       153
       +
           @param posts The posts to include in the feed *)

     

       154
       154
       +
       

     

       155
       155
       +
       val jsonfeed_to_string : ?minify:bool -> Jsonfeed.t -> (string, string) result

     

       156
       156
       +
       (** [jsonfeed_to_string ?minify jsonfeed] serializes a JSONFeed to a string.

     

       157
       157
       +
       

     

       158
       158
       +
           @param minify If true, output compact JSON; if false, pretty-print (default: false) *)

     

       159
       159
       +
       

     

       160
       160
       +
       type feed_content = Atom of Syndic.Atom.feed | Rss2 of Syndic.Rss2.channel | JSONFeed of Jsonfeed.t

     

       161
       161
       +
       (** The native format of a feed. *)

     

       162
       162
       +
       

     

       163
       163
       +
       val feed_content : feed -> feed_content

     

       164
       164
       +
       (** [feed_content feed] returns the feed in its native format (Atom, RSS2, or JSONFeed).

     

       165
       165
       +
           This allows access to format-specific features like JSONFeed attachments. *)

+55 -4

stack/river/lib/river_store.ml

···

       20
       20
        
         feed_name : string;

     

       21
       21
        
         feed_title : string;

     

       22
       22
        
         stored_at : Ptime.t;

     

       23
       23
       +
         tags : string list;

     

       24
       24
       +
         summary : string option;

     

       23
       25
        
       }

     

       24
       26
        
       

     

       25
       27
        
       type feed_info = {

     
···

       72
       74
        
           "feed_name", `String entry.feed_name;

     

       73
       75
        
           "feed_title", `String entry.feed_title;

     

       74
       76
        
           "stored_at", `String (Ptime.to_rfc3339 entry.stored_at);

     

       77
       77
       +
           "tags", `List (List.map (fun t -> `String t) entry.tags);

     

       78
       78
       +
           "summary", (match entry.summary with Some s -> `String s | None -> `Null);

     

       75
       79
        
         ]

     

       76
       80
        
       

     

       77
       81
        
       let entry_of_json json =

     
···

       94
       98
        
           feed_name = json |> member "feed_name" |> to_string;

     

       95
       99
        
           feed_title = json |> member "feed_title" |> to_string;

     

       96
       100
        
           stored_at = json |> member "stored_at" |> to_string |> parse_time;

     

       101
       101
       +
           tags = (try json |> member "tags" |> to_list |> List.map to_string with _ -> []);

     

       102
       102
       +
           summary = (try json |> member "summary" |> to_string_option with _ -> None);

     

       97
       103
        
         }

     

       98
       104
        
       

     

       99
       105
        
       let feed_meta_to_json meta =

     
···

       138
       144
        
       

     

       139
       145
        
       (* Convert Post.t to stored_entry *)

     

       140
       146
        
       let entry_of_post ~feed_url ~feed_name ~feed_title (post : Post.t) =

     

       141
       141
       -
         let atom_id = match post.link with

     

       142
       142
       -
           | Some uri -> Uri.to_string uri

     

       143
       143
       -
           | None -> Digest.to_hex (Digest.string post.title)

     

       144
       144
       -
         in

     

       147
       147
       +
         let atom_id = post.id in  (* Use the post's unique ID *)

     

       145
       148
        
         let updated = match post.date with

     

       146
       149
        
           | Some d -> d

     

       147
       150
        
           | None -> Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get

     
···

       160
       163
        
           feed_name;

     

       161
       164
        
           feed_title;

     

       162
       165
        
           stored_at = Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get;

     

       166
       166
       +
           tags = post.tags;

     

       167
       167
       +
           summary = post.summary;

     

       163
       168
        
         }

     

       164
       169
        
       

     

       165
       170
        
       (* Convert Syndic.Atom.entry to stored_entry *)

     
···

       194
       199
        
           | l :: _ -> Some l.href

     

       195
       200
        
           | [] -> None

     

       196
       201
        
         in

     

       202
       202
       +
         (* Extract tags from categories *)

     

       203
       203
       +
         let tags = List.map (fun cat -> cat.Syndic.Atom.term) atom_entry.categories in

     

       204
       204
       +
         (* Extract summary *)

     

       205
       205
       +
         let summary = match atom_entry.summary with

     

       206
       206
       +
           | Some s -> Some (Util.string_of_text_construct s)

     

       207
       207
       +
           | None -> None

     

       208
       208
       +
         in

     

       197
       209
        
         {

     

       198
       210
        
           atom_id;

     

       199
       211
        
           title = Util.string_of_text_construct atom_entry.title;

     
···

       207
       219
        
           feed_name;

     

       208
       220
        
           feed_title;

     

       209
       221
        
           stored_at = Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get;

     

       222
       222
       +
           tags;

     

       223
       223
       +
           summary;

     

       210
       224
        
         }

     

       211
       225
        
       

     

       212
       226
        
       (* Feed metadata management *)

     
···

       360
       374
        
         ) entries in

     

       361
       375
        
         let sorted = List.sort (fun a b -> Ptime.compare b.updated a.updated) all_entries in

     

       362
       376
        
         List.filteri (fun i _ -> i < limit) sorted

     

       377
       377
       +
       

     

       378
       378
       +
       let find_entry_by_id store ~id =

     

       379
       379
       +
         Log.debug (fun m -> m "Searching for entry with ID: %s" id);

     

       380
       380
       +
         let entries = Cacheio.scan store.cache in

     

       381
       381
       +
         let matching_entry = List.find_map (fun (cache_entry : Cacheio.Entry.t) ->

     

       382
       382
       +
           let key = Cacheio.Entry.key cache_entry in

     

       383
       383
       +
           if String.contains key '/' &&

     

       384
       384
       +
              String.ends_with ~suffix:"entries/" (String.sub key 0 (String.rindex key '/') ^ "/") then

     

       385
       385
       +
             Eio.Switch.run @@ fun sw ->

     

       386
       386
       +
             match Cacheio.get store.cache ~key ~sw with

     

       387
       387
       +
             | None -> None

     

       388
       388
       +
             | Some source ->

     

       389
       389
       +
                 (try

     

       390
       390
       +
                   let json_str = Eio.Buf_read.(parse_exn take_all) source ~max_size:Int.max_int in

     

       391
       391
       +
                   let json = Yojson.Safe.from_string json_str in

     

       392
       392
       +
                   let entry = entry_of_json json in

     

       393
       393
       +
                   (* Check if atom_id matches exactly or contains the search id *)

     

       394
       394
       +
                   let contains_substring s substr =

     

       395
       395
       +
                     try

     

       396
       396
       +
                       let _ = Str.search_forward (Str.regexp_string substr) s 0 in

     

       397
       397
       +
                       true

     

       398
       398
       +
                     with Not_found -> false

     

       399
       399
       +
                   in

     

       400
       400
       +
                   if entry.atom_id = id || String.starts_with ~prefix:id entry.atom_id ||

     

       401
       401
       +
                      contains_substring entry.atom_id id then

     

       402
       402
       +
                     Some entry

     

       403
       403
       +
                   else

     

       404
       404
       +
                     None

     

       405
       405
       +
                 with e ->

     

       406
       406
       +
                   Log.err (fun m -> m "Failed to parse entry: %s" (Printexc.to_string e));

     

       407
       407
       +
                   None)

     

       408
       408
       +
           else None

     

       409
       409
       +
         ) entries in

     

       410
       410
       +
         (match matching_entry with

     

       411
       411
       +
          | Some e -> Log.debug (fun m -> m "Found entry: %s" e.title)

     

       412
       412
       +
          | None -> Log.debug (fun m -> m "No entry found with ID: %s" id));

     

       413
       413
       +
         matching_entry

     

       363
       414
        
       

     

       364
       415
        
       (* Entry management *)

     

       365
       416

stack/river/lib/river_store.mli

···

       77
       77
        
       

     

       78
       78
        
         stored_at : Ptime.t;

     

       79
       79
        
         (** When this entry was stored *)

     

       80
       80
       +
       

     

       81
       81
       +
         tags : string list;

     

       82
       82
       +
         (** Tags associated with the entry *)

     

       83
       83
       +
       

     

       84
       84
       +
         summary : string option;

     

       85
       85
       +
         (** Summary/excerpt of the entry *)

     

       80
       86
        
       }

     

       81
       87
        
       

     

       82
       88
        
       (** Feed metadata *)

     
···

       166
       172
        
       

     

       167
       173
        
       (** Get the most recent entries across all feeds *)

     

       168
       174
        
       val get_recent_entries : t -> ?limit:int -> unit -> stored_entry list

     

       175
       175
       +
       

     

       176
       176
       +
       (** Find an entry by ID across all feeds (searches by atom_id) *)

     

       177
       177
       +
       val find_entry_by_id : t -> id:string -> stored_entry option

     

       169
       178
        
       

     

       170
       179
        
       (** {1 Entry Management} *)

     

       171
       180

+6 -3

stack/river/river.opam

···

       1
       1
        
       # This file is generated by dune, edit dune-project instead

     

       2
       2
        
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "RSS2 and Atom feed aggregator for OCaml"

     

       4
       4
       -
       description: "RSS2 and Atom feed aggregator for OCaml"

     

       3
       3
       +
       synopsis: "RSS2, Atom and JSON Feed aggregator for OCaml"

     

       4
       4
       +
       description: "RSS2, Atom and JSON Feed aggregator for OCaml"

     

       5
       5
        
       maintainer: ["KC Sivaramakrishnan <sk826@cl.cam.ac.uk>"]

     

       6
       6
        
       authors: ["KC Sivaramakrishnan <sk826@cl.cam.ac.uk>"]

     

       7
       7
        
       license: "MIT"

     
···

       9
       9
        
       doc: "https://kayceesrk.github.io/river/"

     

       10
       10
        
       bug-reports: "https://github.com/kayceesrk/river/issues"

     

       11
       11
        
       depends: [

     

       12
       12
       -
         "ocaml" {>= "4.08.0"}

     

       12
       12
       +
         "ocaml" {>= "5.2.0"}

     

       13
       13
        
         "dune" {>= "3.0"}

     

       14
       14
        
         "syndic" {>= "1.5"}

     

       15
       15
        
         "eio" {>= "1.0"}

     
···

       25
       25
        
         "yojson"

     

       26
       26
        
         "fmt"

     

       27
       27
        
         "xdge"

     

       28
       28
       +
         "jsonfeed" {>= "1.1.0"}

     

       29
       29
       +
         "jsont" {>= "0.2.0"}

     

       30
       30
       +
         "bytesrw"

     

       28
       31
        
         "odoc" {with-doc}

     

       29
       32
        
       ]

     

       30
       33
        
       build: [