TyXML

Introduction

The templating approach proposed by Dream may also be replaced by TyXML. This does not work like template-based string extrapolation, but rather uses a set of functions eponymous to HTML tags. These functions build the HTML result and guarantee that it is well-formed. See The TyXML page.

Data preparation

The data preparation is exactely the same than with the Dream templating system excepted that TyXML can't insert an HTML snippet given by Dream.csrf_tag. The alternative is to use Dream.csrf_token and create afterwards the hidden input tag.

HTML rendering

The idea is to use plain funtions like html, head, body, div, p, which all generate a HTML snippet. The OCaml type system is used to enforce a strict HTML conformity.

The usual syntax is tag ~a:[ a_attribute_name atribut_value; ... ] [ tag_list ]. Instead of a tag, we can use txt a_string. However, there are exceptions. html requires 2 tags instead of a list (a head and a body), input accepts () instead of a tag list. These exceptions guarantee the strict HTML conformance. In the same way, most attributes accept a string, but some others, a constant compatible with a polymorphic variant type. Typically, a_input_type accepts things like `Hidden, `Text, `Password. a_button_type accepts things like `Submit, and a_method (for forms), `Post and other form submition keyword.

The strict conformance is incompatible with previous examples: their output hierarchy (table/tr/form/td/...) was designed to layaout one form per table row. However, since it is malformed HTML, it can't be generated by TyXML. A simpler layout has been used instead (table/tr/td/form), but it can't place each input field in a separate column.

open Tyxml

let render ~table ~logged ~csrf_token =
  let table' = table in
  Format.asprintf "%a" (Html.pp ())
    Html.(html 
     (head
        (title (txt "Database error"))
        [
          style [
            txt {css|
h1 {
  border-bottom-style:solid;
  border-bottom-width:5px;
  border-bottom-color:#844;
  font-family: Verdana, sans-serif; 
  font-style: italic;
}

    table { border-collapse: collapse; border: 2px solid #08c;}
    td, th { border: 1px solid #08c; padding: 8px; }
    input { width:300px; margin:5px; }
    button { margin:5px; }
                 |css} ]
     ])
     (body (
        [
          h1 [ txt "Private" ]
        ]
        @
        (if logged then
           [
             p [ txt "You are logged." ];
             p [ a ~a:[ a_href "private" ]
                   [ txt "private directory" ]];
             p [ a ~a:[ a_href "/logout.html" ]
                   [ txt "Logout" ]];
           ]
         else
           [
             p [ a ~a:[ a_href "/login.html" ] [ txt "Login" ]];
           ]
        )
        @
        [
          h1 [ txt "T1 table" ];
          table (
            [
              tr ~a:[ a_style "background: #08C" ] [
                td [
                  form ~a:[ a_action "#"; a_method `Post ] [
                    input ~a:[ a_input_type `Hidden;
                               a_name "dream.csrf";
                               a_value csrf_token ] ();
                    input ~a:[ a_input_type `Text;
                               a_name "value"; a_value "" ] ();
                    button ~a:[ a_button_type `Submit;
                                a_name "action";
                                a_text_value "insert" ]
                      [ txt "Insert" ]
                    ]
                  ]
                ] 
            ]
            @
            List.map (fun (id, value) ->
              tr [
                td [
                  form ~a:[ a_action "#"; a_method `Post ] [
                      input ~a:[ a_input_type `Hidden;
                                 a_name "id";
                                 a_value (string_of_int id) ] ();
                      input ~a:[ a_input_type `Hidden;
                                 a_name "dream.csrf";
                                 a_value csrf_token ] ();
                      input ~a:[ a_input_type `Text;
                                 a_name "value";
                                 a_value value ] ();
                      button ~a:[ a_button_type `Submit;
                                  a_name "action";
                                  a_text_value "change" ]
                        [ txt "Change" ];
                      button ~a:[ a_button_type `Submit;
                                  a_name "action";
                                  a_text_value "delete" ]
                        [ txt "Delete" ];
                    ]
                  ]
                ]
              ) table'
            )
        ]
        )
     )
  )