From f192457e19486cdfbc8ac62684d33ac4b6c82bc1 Mon Sep 17 00:00:00 2001 From: Marc Coquand Date: Sun, 3 Dec 2023 12:51:56 -0600 Subject: Add post and more --- lib/post.ml | 33 +++++++++++++++++++++++++++++++++ lib/xml.ml | 54 ++++++++++++++++++++++++++++++++++++++++++++++-------- lib/xml.mli | 13 ------------- 3 files changed, 79 insertions(+), 21 deletions(-) delete mode 100644 lib/xml.mli (limited to 'lib') diff --git a/lib/post.ml b/lib/post.ml index 744e296..5c3d494 100644 --- a/lib/post.ml +++ b/lib/post.ml @@ -6,8 +6,41 @@ type t = { tags : string list; published : string; author : string; + author_link : string; } +let published t = t.published + +(* RSS *) + +let to_rss_entry post = + Xml.tag "entry" [] + [ + Xml.tag "title" [] [ Xml.entry (post.author ^ " - " ^ post.link) ]; + Xml.tag "id" [] [ Xml.entry post.link ]; + Xml.tag "updated" [] [ Xml.entry post.published ]; + Xml.tag "summary" + [ ("xml:lang", "\"en\""); ("type", "\"html\"") ] + [ Xml.entry post.summary ]; + ] + +(* DB *) + +let db = ref [] + +let add (entry : t) = + db := entry :: !db; + print_endline (entry.link ^ " added to db"); + print_endline ("New db size: " ^ string_of_int (List.length !db)) + +let get_all () = + print_endline ("db size: " ^ string_of_int (List.length !db)); + !db + +let latest_post () = match !db with [] -> None | x :: _ -> Some x + +(* Mastodon integration *) + type mastodon_tag = { kind : string; [@key "type"] name : string; diff --git a/lib/xml.ml b/lib/xml.ml index fe4abdc..d5f8df3 100644 --- a/lib/xml.ml +++ b/lib/xml.ml @@ -1,10 +1,48 @@ -type xml = Tag of string * xml list | String of string +type attribute = string * string -let tag name body = Tag (name, body) -let format, format_list = Format.(fprintf, pp_print_list) +type xml = + | Tag of string * attribute list * xml list + | String of string + | Closing_tag of string * attribute list -let rec format_xml f = function - | Tag (name, body) -> - let format_body = format_list format_xml in - format f "@[<%s>@,%a@;<0 -3>@]" name format_body body name - | String text -> format f "%s" text +let tag name attributes body = Tag (name, attributes, body) +let entry value = String value +let closing_tag name attributes = Closing_tag (name, attributes) + +let format_attributes attributes = + let format_attribut (name, value) = Printf.sprintf " %s=\"%s\"" name value in + String.concat "" (List.map format_attribut attributes) + +let rec format = function + | Tag (name, attributes, body) -> + let body = List.map format body in + String.concat "" + [ + "<"; + name; + " "; + format_attributes attributes; + ">"; + String.concat "" body; + ""; + ] + | String text -> text + | Closing_tag (name, attributes) -> + String.concat "" [ "<"; name; " "; format_attributes attributes; "/>" ] + +let format_rss host_name last_updated entries = + tag "feed" + [ ("xml:base", host_name) ] + [ + tag "title" [] [ entry "Sensemaking Galaxy" ]; + tag "subtitle" [] [ entry "A collection of sensemaking links" ]; + closing_tag "link" [ ("href", host_name ^ "/feed.xml"); ("rel", "self") ]; + closing_tag "link" [ ("href", host_name) ]; + tag "id" [] [ entry host_name ]; + tag "updated" [] [ entry last_updated ]; + tag "author" [] [ tag "name" [] [ entry "Sensemaking Galaxy" ] ]; + tag "entry" [] entries; + ] + |> format diff --git a/lib/xml.mli b/lib/xml.mli deleted file mode 100644 index e1d3eb9..0000000 --- a/lib/xml.mli +++ /dev/null @@ -1,13 +0,0 @@ -type xml = Tag of string * xml list | String of string - -val tag : string -> xml list -> xml -val format : Format.formatter -> ('a, Format.formatter, unit) format -> 'a - -val format_list : - ?pp_sep:(Format.formatter -> unit -> unit) -> - (Format.formatter -> 'a -> unit) -> - Format.formatter -> - 'a list -> - unit - -val format_xml : Format.formatter -> xml -> unit -- cgit v1.2.3