source: code/trunk/src/converters/html.ml@ 1

open Tyxml.Html
open Logarion

let to_string tyxml = Format.asprintf "%a" (Tyxml.Html.pp ()) tyxml

let head ~style linker t =
  head (title (pcdata t)) [
         link ~rel:[`Stylesheet] ~href:(linker style) ();
         link ~rel:[`Alternate]  ~href:(linker "/feed.atom") ~a:[a_mime_type "application/atom+xml"] ();
         meta ~a:[a_charset "utf-8"] ();
       ]

let default_style = "/static/main.css"

let page ?(style=default_style) linker head_title header main =
  html (head ~style linker head_title) (body [ header; main ])

let anchor url content = a ~a:[ a_href (uri_of_string url) ] content

let div ?(style_class="") content =
  let a = if style_class <> "" then [a_class [style_class]] else [] in
  div ~a content

let main = main

let unescaped_data = Unsafe.data
let data = pcdata
let title = h1
let header = header

let pipe = span ~a:[a_class ["pipe"]] [pcdata " | "]

let meta ~abstract ~authors ~date ~series ~topics ~keywords ~uuid =
  let opt_span name value = if String.length value > 0 then (span [pipe; pcdata (name ^ value)]) else pcdata "" in
  let authors = List.fold_left (fun acc x -> a ~a:[a_rel [`Author]] [pcdata x] :: acc) [] authors in
  [ p ~a:[a_class ["abstract"]] [Unsafe.data abstract]; ]
  @ authors
  @ [
      pipe;
      time ~a:[a_datetime date] [pcdata date];
      pipe;
      opt_span "series: " series;
      opt_span "topics: " topics;
      opt_span "keywords: " keywords;
      div [pcdata ("id: " ^ uuid)];
    ]
  |> div ~style_class:"meta"

let note = article

let text_item path meta =
  let module Meta = Logarion.Meta in
  tr [
      td [ a ~a:[a_class ["title"]; a_href (path ^ Meta.alias meta ^ ".html")] [data meta.Meta.title] ];
      td [ span [pcdata Meta.(stringset_csv meta.keywords)] ];
      td [ time @@ [unescaped_data Meta.Date.(pretty_date (listing meta.Meta.date))] ];
    ]

let listing_texts path metas =
  let item meta = text_item path meta in
  table @@ List.map item metas

let listing_index path metas =
  let items topic =
    List.fold_left Meta.(fun a e -> if StringSet.mem topic e.topics then text_item path e :: a else a)
      [] metas
  in
  let item topic =
    let module Meta = Logarion.Meta in
    [ h3 ~a:[a_id topic] [pcdata topic]; table (items topic)]
  in
  List.fold_left (fun a e -> a @ item e) []
  @@ Meta.StringSet.elements
  @@ List.fold_left Meta.(fun a e -> unique_topics a e) Meta.StringSet.empty metas

module Renderer = struct
  let meta meta e =
    let e = List.hd e in
    match e with
    | "urn_name" -> [unescaped_data @@ "/note/" ^ Logarion.Meta.alias meta]
    | "date" | "date_created" | "date_edited" | "date_published" | "date_human" ->
       [time @@ [unescaped_data @@ Logarion.Meta.value_with_name meta e]]
    | tag -> [unescaped_data @@ Logarion.Meta.value_with_name meta tag]

  let note note e = match List.hd e with
    | "body" -> [unescaped_data @@ Omd.to_html @@ Omd.of_string note.Logarion.Note.body]
    | _      -> meta note.Logarion.Note.meta e

  let archive archive e = match List.hd e with
    | "title" -> [h1 [anchor ("index.html") [data archive.Logarion.Archive.Configuration.title]]]
    | tag -> prerr_endline ("unknown tag: " ^ tag); [unescaped_data ""]
end

let form ymd =
  let article_form =
    let input_set title input = p [ label [ pcdata title; input ] ] in
    let open Note in
    let open Meta in
    let authors = AuthorSet.to_string ymd.meta.authors in
    [
      input ~a:[a_name "uuid"; a_value (Id.to_string ymd.meta.uuid); a_input_type `Hidden] ();
      input_set
        "Title"
        (input ~a:[a_name "title"; a_value ymd.meta.title; a_required ()] ());
      input_set
        "Authors"
        (input ~a:[a_name "authors"; a_value authors] ());
      input_set
        "Topics"
        (input ~a:[a_name "topics"; a_value (stringset_csv ymd.meta.topics)] ());
      input_set
        "Categories"
        (input ~a:[a_name "categories"; a_value (CategorySet.to_csv ymd.meta.categories)] ());
      input_set
        "Keywords"
        (input ~a:[a_name "keywords"; a_value (stringset_csv ymd.meta.keywords)] ());
      input_set
        "Series"
        (input ~a:[a_name "series"; a_value (stringset_csv ymd.meta.series)] ());
      input_set
        "Abstract"
        (input ~a:[a_name "abstract"; a_value ymd.meta.abstract] ());
      input_set
        "Text"
        (textarea ~a:[a_name "body"] (pcdata ymd.body));
      p [ button ~a:[a_button_type `Submit] [pcdata "Submit"] ];
    ]
  in
  div
    [ form
        ~a:[a_method `Post; a_action (uri_of_string "/post.note"); a_accept_charset ["utf-8"]]
        [ fieldset ~legend:(legend [pcdata "Article"]) article_form ]
    ]