diff options
author | Marc Coquand <marcc@fastmail.fr> | 2023-12-03 12:51:56 -0600 |
---|---|---|
committer | Marc Coquand <marcc@fastmail.fr> | 2023-12-03 12:51:56 -0600 |
commit | f192457e19486cdfbc8ac62684d33ac4b6c82bc1 (patch) | |
tree | 3007a6ca6f5c15a1248964d9dd4353ba6d40e281 /lib/xml.ml | |
parent | 0bc5b9db320a2f5b12f597dfc4fdf12671f58939 (diff) | |
download | wormhole-f192457e19486cdfbc8ac62684d33ac4b6c82bc1.tar.gz wormhole-f192457e19486cdfbc8ac62684d33ac4b6c82bc1.tar.bz2 wormhole-f192457e19486cdfbc8ac62684d33ac4b6c82bc1.zip |
Add post and more
Diffstat (limited to 'lib/xml.ml')
-rw-r--r-- | lib/xml.ml | 54 |
1 files changed, 46 insertions, 8 deletions
@@ -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 "@[<hv 3><%s>@,%a@;<0 -3></%s>@]" 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; + "</"; + name; + ">"; + ] + | 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 |