| 1 | let esc = Xml_print.encode_unsafe_char
|
|---|
| 2 |
|
|---|
| 3 | let header config url =
|
|---|
| 4 | let open Logarion.Meta in
|
|---|
| 5 | let open Logarion.Archive.Configuration in
|
|---|
| 6 | "<title>" ^ config.title ^ "</title>"
|
|---|
| 7 | (* TODO: ^ "<subtitle>A subtitle.</subtitle>"*)
|
|---|
| 8 | ^ "<link rel=\"alternate\" type=\"text/html\" href=\"" ^ url ^ "\"/>"
|
|---|
| 9 | ^ "<link rel=\"self\" type=\"application/atom+xml\" href=\"" ^ url ^ "/feed.atom\" />"
|
|---|
| 10 | ^ "<id>urn:uuid:" ^ Id.to_string config.id ^ "</id>"
|
|---|
| 11 | ^ "<updated>" ^ Ptime.to_rfc3339 (Ptime_clock.now ()) ^ "</updated>"
|
|---|
| 12 |
|
|---|
| 13 | let opt_element tag_name content =
|
|---|
| 14 | if content <> ""
|
|---|
| 15 | then "<" ^ tag_name ^ ">" ^ content ^ "</" ^ tag_name ^ ">"
|
|---|
| 16 | else ""
|
|---|
| 17 |
|
|---|
| 18 | let entry url note =
|
|---|
| 19 | let open Logarion in
|
|---|
| 20 | let meta = note.Note.meta in
|
|---|
| 21 | let u = "note/" ^ Meta.alias meta in
|
|---|
| 22 | let open Meta in
|
|---|
| 23 | let authors elt a =
|
|---|
| 24 | a ^ "<author>"
|
|---|
| 25 | ^ (opt_element "name" @@ esc elt.Author.name)
|
|---|
| 26 | ^ (opt_element "uri" @@ esc (Uri.to_string elt.Author.address))
|
|---|
| 27 | ^ "</author>"
|
|---|
| 28 | in
|
|---|
| 29 | ("<entry>"
|
|---|
| 30 | ^ "<title>" ^ meta.title ^ "</title>"
|
|---|
| 31 | ^ "<id>urn:uuid:" ^ Meta.Id.to_string meta.uuid ^ "</id>"
|
|---|
| 32 | ^ "<link rel=\"alternate\" href=\"" ^ url ^ "/" ^ u ^ "\" />"
|
|---|
| 33 | ^ "<updated>" ^ Date.(meta.date |> listing |> rfc_string) ^ "</updated>"
|
|---|
| 34 | ^ Meta.AuthorSet.fold authors meta.authors ""
|
|---|
| 35 | ^ opt_element "summary" @@ esc meta.abstract)
|
|---|
| 36 | ^ Meta.StringSet.fold (fun elt a -> a ^ "<category term=\"" ^ elt ^ "\"/>") meta.topics ""
|
|---|
| 37 | ^ "<content type=\"xhtml\"><div xmlns=\"http://www.w3.org/1999/xhtml\">"
|
|---|
| 38 | ^ (Omd.to_html @@ Omd.of_string @@ esc note.Note.body)
|
|---|
| 39 | ^ "</div></content>"
|
|---|
| 40 | ^ "</entry>"
|
|---|
| 41 |
|
|---|
| 42 | let feed config url note_fn articles =
|
|---|
| 43 | let fold_valid feed m = match note_fn m.Logarion.Meta.uuid with
|
|---|
| 44 | | Some note -> feed ^ "\n" ^ entry url note
|
|---|
| 45 | | None -> feed
|
|---|
| 46 | in
|
|---|
| 47 | "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n<feed xmlns=\"http://www.w3.org/2005/Atom\">\n"
|
|---|
| 48 | ^ header config url
|
|---|
| 49 | ^ List.fold_left fold_valid "" articles
|
|---|
| 50 | ^ "</feed>"
|
|---|
