added atom feeds

src/atom.ml

@@ -0,0 +1,29 @@
+let header logarion =
+  let open Logarion.Configuration in
+  "<title>" ^ logarion.title ^ "</title>"
+  (* ^ "<subtitle>A subtitle.</subtitle>"
+  ^ "<link href=\"http://example.org/feed/\" rel=\"self\" />"
+  ^ "<link href=\"http://example.org/\" />" *)
+  ^ "<id>urn:uuid:" ^ Logarion.Id.to_string logarion.id ^ "</id>"
+  ^ "<updated>" ^ Ptime.(to_rfc3339 (Ptime_clock.now ())) ^ "</updated>"
+
+let entry url logarion ymd =
+  let open Ymd in
+  let open Ymd.Author in
+  "<entry>"
+  ^ "<title>" ^ ymd.meta.title ^ "</title>"
+  ^ "<link rel=\"alternate\" type=\"text/html\" href=\"" ^ url ^ "\"/>"
+  ^ "<id>urn:uuid:" ^ Ymd.Id.to_string  ymd.meta.uuid ^ "</id>"
+  ^ "<updated>" ^ Ymd.Date.(ymd.meta.date |> last |> rfc_string) ^ "</updated>"
+  ^ "<author><name>" ^ ymd.meta.author.name ^ "</name><email>" ^ ymd.meta.author.email ^"</email></author>"
+  ^ "<summary>" ^ ymd.meta.abstract ^ "</summary>"
+  ^ "<content type=\"xhtml\"><div xmlns=\"http://www.w3.org/1999/xhtml\">"
+  ^ Omd.to_html (Omd.of_string ymd.body)
+  ^ "</div></content>"
+  ^ "</entry>"
+
+let feed url logarion articles =
+  "<?xml version=\"1.0\" encoding=\"utf-8\"?><feed xmlns=\"http://www.w3.org/2005/Atom\">"
+  ^ header logarion
+  ^ List.fold_left (fun body (f,ymd) -> body ^ entry url logarion ymd) "" articles
+  ^ "</feed>"

src/html.ml

@@ -45,11 +45,6 @@ let article_link (file, meta) =
 
 let of_file_meta_pairs ?(header_tpl=None) ?(listing_tpl=None) ?(entry_tpl=None) blog_url lgrn file_meta_pairs =
   let t = Logarion.Configuration.(lgrn.title) in
-  let file_meta_pairs =
-    file_meta_pairs
-    |> List.filter Ymd.(fun (_,a) -> not @@ CategorySet.categorised [Category.Unlisted] a.categories)
-    |> List.fast_sort Ymd.(fun (_,a) (_,b) -> compare (Date.last a.date) (Date.last b.date))
-  in
   logarion_page
     ~header_tpl
     blog_url

src/logarion.ml

@@ -1,29 +1,37 @@
+module Id = struct
+  include Ymd.Id
+end
+
 module Configuration = struct
   type t = {
       repository : string;
       title : string;
       owner : string;
       email : string;
+      id : Id.t;
     }
 
-  let default = {
+  let default ?(id=(Id.generate ())) () = {
       repository = Sys.getenv "HOME" ^ "/ymd";
       title = "Logarion journal";
       owner = "";
       email = "";
+      id;
     }
 
   let of_filename fn =
     let result = Toml.Parser.from_filename fn in
     match result with
-    | `Error (str, loc) -> default
+    | `Error (str, loc) -> default ()
     | `Ok toml ->
        let str = Logarion_toml.str toml "general" in
+       let default = default () in
        {
          repository = str "repository" default.repository;
          title = str "title" default.title;
          owner = str "owner" default.owner;
          email = str "email" default.email;
+         id = match Id.of_string (str "uuid" "") with Some id -> id | None -> Id.generate();
        }
 end
 
@@ -58,6 +66,13 @@ let file_meta_pairs () =
   let t y = (y, (of_file (titledir ^ y)).Ymd.meta) in
   List.map t ymds
 
+let file_ymd_pairs () =
+  let files = Array.to_list @@ Sys.readdir titledir in
+  let ymd_list a e =  if BatString.ends_with e extension then List.cons e a else a in
+  let ymds = List.fold_left ymd_list [] files in
+  let t y = (y, (of_file (titledir ^ y))) in
+  List.map t ymds
+
 let rec next_semantic_filepath ?(version=0) ymd =
   let candidate = titledir ^ (Ymd.filename ymd) ^ "." ^ (string_of_int version) ^ extension in
   if Sys.file_exists candidate then next_semantic_filepath ~version:(version+1) ymd

src/web.ml

@@ -87,6 +87,16 @@ let () =
   let page_of_ymd = Html.of_ymd ~header_tpl ~text_tpl blog_url lgrn in
   let form_of_ymd = Html.form ~header_tpl blog_url lgrn in
   let list_of_ymds = Html.of_file_meta_pairs ~header_tpl ~listing_tpl ~entry_tpl blog_url lgrn in
+  let latest_listed_meta fmp =
+    fmp
+    |> List.filter Ymd.(fun (_,a) -> not @@ CategorySet.categorised [Category.Unlisted] a.categories)
+    |> List.fast_sort Ymd.(fun (_,b) (_,a) -> compare (Date.last a.date) (Date.last b.date))
+  in
+  let latest_listed_ymd fyp =
+    fyp
+    |> List.filter Ymd.(fun (_,a) -> not @@ CategorySet.categorised [Category.Unlisted] a.meta.categories)
+    |> List.fast_sort Ymd.(fun (_,b) (_,a) -> compare (Date.last a.meta.date) (Date.last b.meta.date))
+  in
   App.empty
   |> App.port webcfg.Configuration.port
   |> middleware @@ Middleware.static ~local_path:"./share/static" ~uri_prefix:"/static"
@@ -95,5 +105,6 @@ let () =
   |> get "/new"       (fun _   -> Lwt.return (Ymd.blank_ymd ()) >|= form_of_ymd >>= html_response)
   |> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= page_of_ymd >>= html_response)
   |> get "/!/:ttl"    (fun req -> ret_param "ttl" req >|= L.latest_file_meta_pair >|= ymd_or_error >|= page_of_ymd >>= html_response)
-  |> get "/"          (fun _   -> Lwt.return (L.file_meta_pairs ()) >|= list_of_ymds >>= html_response)
+  |> get "/feed.atom" (fun _   -> Lwt.return (L.file_ymd_pairs ())  >|= latest_listed_ymd  >|= Atom.feed webcfg.url lgrn >>= html_response)
+  |> get "/"          (fun _   -> Lwt.return (L.file_meta_pairs ()) >|= latest_listed_meta >|= list_of_ymds >>= html_response)
   |> App.run_command