My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(*
2 * Copyright (c) 2014, OCaml.org project
3 * Copyright (c) 2015 KC Sivaramakrishnan <sk826@cl.cam.ac.uk>
4 *
5 * Permission to use, copy, modify, and distribute this software for any
6 * purpose with or without fee is hereby granted, provided that the above
7 * copyright notice and this permission notice appear in all copies.
8 *
9 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16 *)
17
18let src = Logs.Src.create "river" ~doc:"River RSS/Atom aggregator"
19module Log = (val Logs.src_log src : Logs.LOG)
20
21(* Keep Client module internal *)
22module Internal_client = Client
23
24(* Abstract session type *)
25type session = Client.t
26
27type source = Feed.source = { name : string; url : string }
28type feed = Feed.t
29type post = Post.t
30
31(* Session management *)
32let init ~sw env =
33 Log.info (fun m -> m "Initializing River session");
34 Internal_client.create ~sw env
35
36let with_session env f =
37 Log.info (fun m -> m "Creating River session");
38 Internal_client.with_client env f
39
40(* Feed operations *)
41let fetch session source =
42 Log.info (fun m -> m "Fetching feed: %s" source.name);
43 Feed.fetch session source
44
45let name feed = feed.Feed.name
46let url feed = feed.Feed.url
47
48let posts feeds =
49 Log.info (fun m -> m "Aggregating posts from %d feed(s)" (List.length feeds));
50 let result = Post.get_posts feeds in
51 Log.info (fun m -> m "Aggregated %d posts total" (List.length result));
52 result
53
54let title post = post.Post.title
55let link post = post.Post.link
56let date post = post.Post.date
57let feed post = post.Post.feed
58let author post = post.Post.author
59let email post = post.Post.email
60let content post = Soup.to_string post.Post.content
61let id post = post.Post.id
62let tags post = post.Post.tags
63let summary post = post.Post.summary
64
65let meta_description _post =
66 (* TODO: This requires environment for HTTP access *)
67 Log.debug (fun m -> m "meta_description not implemented (requires environment)");
68 None
69
70let seo_image _post =
71 (* TODO: This requires environment for HTTP access *)
72 Log.debug (fun m -> m "seo_image not implemented (requires environment)");
73 None
74
75let create_atom_entries posts =
76 Log.info (fun m -> m "Creating Atom entries for %d posts" (List.length posts));
77 Post.mk_entries posts
78
79(* JSONFeed support *)
80let create_jsonfeed_items posts =
81 Log.info (fun m -> m "Creating JSONFeed items for %d posts" (List.length posts));
82 Post.mk_jsonfeed_items posts
83
84let create_jsonfeed ~title ?home_page_url ?feed_url ?description ?icon ?favicon posts =
85 Log.info (fun m -> m "Creating JSONFeed with %d posts" (List.length posts));
86 let items = create_jsonfeed_items posts in
87 Jsonfeed.create ~title ?home_page_url ?feed_url ?description ?icon ?favicon ~items ()
88
89let jsonfeed_to_string ?(minify = false) jsonfeed =
90 match Jsonfeed.to_string ~minify jsonfeed with
91 | Ok s -> Ok s
92 | Error err -> Error (Jsont.Error.to_string err)
93
94type feed_content =
95 | Atom of Syndic.Atom.feed
96 | Rss2 of Syndic.Rss2.channel
97 | JSONFeed of Jsonfeed.t
98
99let feed_content feed =
100 match feed.Feed.content with
101 | Feed.Atom f -> Atom f
102 | Feed.Rss2 ch -> Rss2 ch
103 | Feed.Json jf -> JSONFeed jf