source: code/trunk/cli/atom.ml@ 14

let esc = Converter.Html.esc

let element tag content = "<" ^ tag ^ ">" ^ content ^ "</" ^ tag ^ ">"

let opt_element tag_name content =
  if content <> ""
  then element tag_name content
  else ""

module P = Parsers.Plain_text.Make (Converter.Html)

let id txt = "<id>urn:uuid:" ^ Logarion.(txt.Text.id) ^ "</id>"
let title text = "<title>" ^ esc text.Logarion.Text.title ^ "</title>"

let authors text =
        let u acc addr = acc ^ element "uri" addr in
  let open Logarion in
  let fn txt a =
        a ^ "<author>" ^ (opt_element "name" @@ esc txt.Person.name)
        ^ (List.fold_left u "" txt.Person.addresses)
        ^ "</author>" in
  Person.Set.fold fn text.Text.authors ""

let updated txt = let open Logarion in
        "<updated>"^ Date.(txt.Text.date |> listing |> rfc_string) ^"</updated>"
        
let htm_entry base_url text =
  let open Logarion in
  let u = Text.short_id text in
  "<entry><link rel=\"alternate\" href=\"" ^ base_url ^ "/" ^ u ^ ".htm\" />"
  ^ title text ^ id text ^ updated text ^ authors text
  ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text)
  ^ String_set.fold (fun elt a -> a ^ "<category term=\"" ^ esc elt ^ "\"/>") (Text.set "topics" text) ""
  ^ "<content type=\"xhtml\"><div xmlns=\"http://www.w3.org/1999/xhtml\">"
  ^ P.of_string text.body ""
  ^ "</div></content></entry>\n"

let gmi_entry base_url text =
  let open Logarion in
  let u = Text.short_id text in
  "<entry><link rel=\"alternate\" href=\"" ^ base_url ^ "/" ^ u ^ ".gmi\" />"
  ^ title text ^ id text ^ updated text ^ authors text
  ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text)
  ^ String_set.fold (fun elt a -> a ^ "<category term=\"" ^ elt ^ "\"/>") (Text.set "topics" text) ""
  ^ "</entry>\n"

let feed title archive_id base_url alternate_type texts =
        let entry, self = match alternate_type with
                | "text/gemini" -> gmi_entry, base_url^"/gmi.atom"
                | "text/html" | _ -> htm_entry, base_url^"/feed.atom" in
  {|<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom" xml:base="|} ^ base_url ^ {|"><title>|}
  ^ title ^ {|</title><link rel="alternate" type="|} ^ alternate_type ^ {|" href="|}
  ^ base_url ^ {|/" /><link rel="self" type="application/atom+xml" href="|}
  ^ self ^ {|" /><id>urn:uuid:|} ^ archive_id ^ "</id><updated>"
  ^ Logarion.Date.now () ^ "</updated>\n"
  ^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" texts
  ^ "</feed>"