Add Atom Suppport for the federated blog

data/blog.md

@@ -6,4 +6,4 @@ description: A federated blog of Webring's member
 The **Federated Blog** allows [webring members](/) to showcase federated
 articles on this page from _time to time_. The list of articles is not
 calculated automatically (via RSS/Atom feeds) but is the result of **a manual
-addition**.
+addition**. You can retrieve the [ATOM feed from the federated blog](/atom.xml).

lib/action/all.ml

@@ -14,6 +14,7 @@ let run (module R : Sigs.RESOLVER) () =
   >>= Css.run (module R)
   >>= Images.run (module R)
   >>= Articles.run (module R) chain
+  >>= Atom.run (module R) chain
   >>= Opml.run (module R) chain
   >>= Chain.run (module R) chain
   >>= Index.run (module R) chain

lib/action/atom.ml

@@ -0,0 +1,6 @@
+let run (module R : Sigs.RESOLVER) chain =
+  Yocaml.Action.write_static_file R.Target.atom
+    (let open Yocaml.Task in
+     R.track_common_dependencies
+     >>> Yocaml.Pipeline.track_file R.Source.articles
+     >>> Model.Articles.atom chain R.Source.articles)

lib/action/atom.mli

@@ -0,0 +1,3 @@
+(** An action that builds the Atom file of the federated blog. *)
+
+val run : (module Sigs.RESOLVER) -> Model.Chain.t -> Yocaml.Action.t

lib/model/article.ml

@@ -52,3 +52,15 @@ let pp ppf article =
     (article |> normalize |> Yocaml.Data.record)
 
 let sort a b = Yocaml.Archetype.Datetime.compare a.date b.date
+
+let to_atom chain { title; synopsis; date; tags; authors; link } =
+  let open Yocaml_syndication in
+  let title = title in
+  let authors = List.map (Chain.as_author chain) authors in
+  let updated = Datetime.make date in
+  let categories = List.map Category.make tags in
+  let url = link |> Link.url |> Url.to_string in
+  let summary = synopsis |> Option.map Atom.text in
+  let links = [ Atom.alternate url ~title ] in
+  Atom.entry ~authors ~updated ~categories ?summary ~links
+    ~title:(Atom.text title) ~id:url ()

lib/model/article.mli

@@ -8,6 +8,7 @@ val authors_in_chain : Chain.t -> t -> bool
 
 val pp : Format.formatter -> t -> unit
 val sort : t -> t -> int
+val to_atom : Chain.t -> t -> Yocaml_syndication.Atom.entry
 
 (** {1 Dealing as metadata} *)
 

lib/model/articles.ml

@@ -38,3 +38,16 @@ let normalize { page; articles } =
       ("articles", list_of (fun x -> record (Article.normalize x)) articles);
       ("has_articles", has_list articles);
     ]
+
+let atom chain path =
+  let open Yocaml_syndication in
+  let open Yocaml.Task in
+  let id = "https://ring.muhokama.fun/atom.xml" in
+  let title = Atom.text "ring.muhokama.fun" in
+  let subtitle = Atom.text "federated blog of Muhokama webring" in
+  let links = [ Atom.self id; Atom.link "https://ring.muhokama.fun" ] in
+  let updated = Atom.updated_from_entries () in
+  let authors = Chain.to_authors chain in
+  fetch chain path
+  >>> Atom.from ~updated ~title ~subtitle ~id ~links ~authors
+        (Article.to_atom chain)

lib/model/articles.mli

@@ -4,6 +4,7 @@ type t
 (** The type describing the federation. *)
 
 val index : ?limit:int -> Chain.t -> Yocaml.Path.t -> (Page.t, t) Yocaml.Task.t
+val atom : Chain.t -> Yocaml.Path.t -> (unit, string) Yocaml.Task.t
 
 (** {1 Dealing as metadata} *)
 

lib/model/chain.ml

@@ -69,5 +69,18 @@ let normalize_elt { pred; curr; succ } =
     @ [ ("pred", string @@ Member.id pred); ("succ", string @@ Member.id succ) ]
     )
 
+let unknow_author = Yocaml_syndication.Person.make "Unknown author"
 let normalize = Yocaml.Data.list_of normalize_elt
 let is_empty = List.is_empty
+
+let to_authors chain =
+  match List.map (fun { curr; _ } -> Member.as_author curr) chain with
+  | [] -> (* Should never happen *) Yocaml.Nel.singleton unknow_author
+  | x :: xs -> Yocaml.Nel.(x :: xs)
+
+let as_author chain id =
+  chain
+  |> List.find_map (fun { curr; _ } ->
+         if String.equal (Member.id curr) id then Some curr else None)
+  |> Option.fold ~none:unknow_author (* Should never happen *)
+       ~some:Member.as_author

lib/model/chain.mli

@@ -31,6 +31,8 @@ val to_list : t -> (Member.t * (Member.t * Member.t)) list
 val to_opml : (t, string) Yocaml.Task.t
 (** [to_opml] An arrow that lift a chain into an OPML file. *)
 
+val as_author : t -> string -> Yocaml_syndication.Person.t
+val to_authors : t -> Yocaml_syndication.Person.t Yocaml.Nel.t
 val is_empty : t -> bool
 val normalize : t -> Yocaml.Data.t
 

lib/model/member.ml

@@ -146,3 +146,8 @@ let to_outline member =
            feed_to_outline title description feed)
   in
   main_feed @ additional_feeds
+
+let as_author m =
+  Yocaml_syndication.Person.make
+    ~uri:(m.main_link |> Link.url |> Url.url)
+    (display_name m)

lib/model/member.mli

@@ -31,6 +31,8 @@ val to_string : t -> string
 val equal : t -> t -> bool
 (** Equality between members. *)
 
+val as_author : t -> Yocaml_syndication.Person.t
+
 (** {1 Dealing as metadata} *)
 
 include Yocaml.Required.DATA_READABLE with type t := t

lib/resolver.ml

@@ -26,6 +26,7 @@ module Make (R : Sigs.RESOLVABLE) = struct
     let root = R.target
     let cache = Path.(R.target / "cache")
     let opml = Path.(R.target / "opml")
+    let atom = Path.(R.target / "atom.xml")
     let ring_opml = Path.(opml / "ring.opml")
     let members = Path.(R.target / "u")
     let css = Path.(R.target / "css")

lib/sigs.mli

@@ -69,6 +69,7 @@ module type RESOLVER = sig
     val css : Yocaml.Path.t
     val fonts : Yocaml.Path.t
     val opml : Yocaml.Path.t
+    val atom : Yocaml.Path.t
     val ring_opml : Yocaml.Path.t
     val index : Yocaml.Path.t
     val images : Yocaml.Path.t

static/css/style.css

@@ -282,6 +282,11 @@ section.articles ul.tags > li::before {
     color: var(--main-contrast-light-color);
 }
 
+footer nav {
+    margin-top: 32px;
+    font-size: 80%;
+}
+
 @media all and (max-width: 1024px) {
     .members {
         grid-template-columns: repeat(2, 1fr);

static/templates/layout.html

@@ -39,6 +39,10 @@ <h1 class="logo">
           <a href="https://github.com/muhokama/ring">free software</a> proudly
           propulsed by <a href="https://gitlab.com/funkywork/yocaml">YOCaml</a>
         </p>
+        <nav>
+          <a class="button" href="/opml/ring.opml">OPML</a>
+          <a class="button" href="/atom.xml">ATOM</a>
+        </nav>
       </div>
     </footer>
   </body>