wip: atom feed for threads

src/content/assets/css/style.css

@@ -141,3 +141,9 @@ a.post-menu-link {
   text-decoration: none;
   color: green;
 }
+
+.rss-logo {
+  height: 30px;
+  width: auto;
+  float: right;
+}

src/content/assets/img/atom.svg

@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> 
+<svg xmlns="http://www.w3.org/2000/svg" version="1.1" width="128px" height="128px" id="RSSicon" viewBox="0 0 256 256">
+<defs>
+<linearGradient x1="0.085" y1="0.085" x2="0.915" y2="0.915" id="RSSg">
+<stop  offset="0.0" stop-color="#E3702D"/><stop  offset="0.1071" stop-color="#EA7D31"/>
+<stop  offset="0.3503" stop-color="#F69537"/><stop  offset="0.5" stop-color="#FB9E3A"/>
+<stop  offset="0.7016" stop-color="#EA7C31"/><stop  offset="0.8866" stop-color="#DE642B"/>
+<stop  offset="1.0" stop-color="#D95B29"/>
+</linearGradient>
+</defs>
+<rect width="256" height="256" rx="55" ry="55" x="0"  y="0"  fill="#CC5D15"/>
+<rect width="246" height="246" rx="50" ry="50" x="5"  y="5"  fill="#F49C52"/>
+<rect width="236" height="236" rx="47" ry="47" x="10" y="10" fill="url(#RSSg)"/>
+<circle cx="68" cy="189" r="24" fill="#FFF"/>
+<path d="M160 213h-34a82 82 0 0 0 -82 -82v-34a116 116 0 0 1 116 116z" fill="#FFF"/>
+<path d="M184 213A140 140 0 0 0 44 73 V 38a175 175 0 0 1 175 175z" fill="#FFF"/>
+</svg>

src/permap.ml

@@ -288,6 +288,16 @@ let babillard_post request =
     | `Wrong_session _ | `Wrong_content_type ->
       Dream.empty `Bad_Request )
 
+let thread_feed_get request =
+  let thread_id = Dream.param request "thread_id" in
+  if Babillard.thread_exist thread_id then
+    let feed = Pp_babillard.feed thread_id in
+    match feed with
+    | Error e -> render_unsafe e request
+    | Ok feed ->
+      Dream.respond ~headers:[ ("Content-Type", "application/atom+xml") ] feed
+  else Dream.respond ~status:`Not_Found "Thread not found"
+
 let thread_get request =
   let thread_id = Dream.param request "thread_id" in
   if Babillard.thread_exist thread_id then
@@ -371,6 +381,7 @@ let routes =
   ; post "/report/:post_id" report_post
   ; get_ "/thread/:thread_id" thread_get
   ; post "/thread/:thread_id" reply_post
+  ; get_ "/thread/:thread_id/feed" thread_feed_get
   ; get_ "/user" user
   ; get_ "/user/:user" user_profile
   ; get_ "/user/:user/avatar" avatar_image

src/pp_babillard.ml

@@ -271,3 +271,59 @@ let get_markers () =
       ops
   in
   Ok markers
+
+(* TODO get from config file? *)
+let server_url = "http://localhost:3696"
+
+(* RFC-3339 date-time *)
+let pp_date fmt date =
+  let date = Unix.gmtime date in
+  Format.fprintf fmt "%04d-%02d-%02dT%02d:%02d:%02dZ" (1900 + date.tm_year)
+    (1 + date.tm_mon) date.tm_mday date.tm_hour date.tm_min date.tm_sec
+
+let pp_feed_entry fmt post =
+  Format.fprintf fmt
+    {|
+  <entry>
+    <title>Atom-Powered Robots Run Amok</title>
+    <id>urn:uuid:%s</id>
+    <updated>%a</updated>
+  <author>
+    <name>%s</name>
+  </author>
+    <content type="html">%s</content>
+    <link rel="alternate" href="%s/thread/%s#%s"/>
+  </entry>
+    |}
+    post.id pp_date post.date post.nick
+    (Dream.html_escape post.comment)
+    server_url post.parent_id post.id
+
+let feed thread_id =
+  let* thread_data, op_post = get_op thread_id in
+  let^ ids = Db.collect_list Q.get_thread_posts thread_id in
+  let* posts = get_posts ids in
+  let posts = List.sort (fun a b -> compare b.date a.date) posts in
+  let last_update = (List.nth posts 0).date in
+  let entries fmt () =
+    (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_feed_entry) fmt posts
+  in
+  (*TODO different  uuid for op and thread ..?*)
+  let feed =
+    Format.asprintf
+      {|<?xml version="1.0" encoding="utf-8"?>
+<feed xmlns="http://www.w3.org/2005/Atom">
+  <title>%s | Permap </title>
+  <link rel="self" href="%s/thread/%s"/>
+  <updated>%a</updated>
+  <author>
+    <name>%s</name>
+  </author>
+  <id>urn:uuid:%s</id>
+  %a
+</feed>
+    |}
+      thread_data.subject server_url thread_id pp_date last_update op_post.nick
+      op_post.id entries ()
+  in
+  Ok feed

src/thread_page.eml.html

@@ -1,9 +1,10 @@
 let f thread_view thread_id request =
 <script type="text/javascript" src="/assets/js/js_thread.js" defer="defer"></script>
       <%s! thread_view %>
+% let thread_url = Format.sprintf "/thread/%s" thread_id in
 % begin match Dream.session "nick" request with
 % | None ->
-% let redirect = Dream.to_percent_encoded (Format.sprintf "/thread/%s" thread_id) in
+% let redirect = Dream.to_percent_encoded thread_url in
 <a href="/login?redirect=<%s redirect%>">Login to reply!</a>
 % | Some _ ->
     <div class="post-form">
@@ -25,3 +26,8 @@ let f thread_view thread_id request =
       </div>
     </form>
 % end;
+% let feed_url = Format.sprintf "%s/feed" thread_url in
+<a type="application/atom+xml" href=<%s! feed_url %> >
+    <img src="/assets/img/atom.svg" class="rss-logo" />
+</a>
+<link rel="alternate" type="application/atom+xml" href=<%s! feed_url %> />