xhtml.opa

/*
    Copyright © 2011, 2012 MLstate

    This file is part of OPA.

    OPA is free software: you can redistribute it and/or modify it under the
    terms of the GNU Affero General Public License, version 3, as published by
    the Free Software Foundation.

    OPA is distributed in the hope that it will be useful, but WITHOUT ANY
    WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
    FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public License for
    more details.

    You should have received a copy of the GNU Affero General Public License
    along with OPA.  If not, see <http://www.gnu.org/licenses/>.
*/

import stdlib.core.{web.core, rpc.core, parser, funaction, mutable.buffer, unification}

/**
 * {1 About this module}
 *
 * {1 where should i start?}
 *
 * {1 what if i need more?}
 */

/**
 * {1 Types defined in this module}
 */

/**
 * The content of a xhtml event handler
 *
 * To allow runtime manipulation of Xhtml, e.g. for (de)serialization, xhtml event handlers have two representations,
 * depending on where they are computed.
 */
@opacapi
type xhtml_event = { expr: FunAction.t /** An actual function. This can only ever happen if we're on the client, executing code generated by the client.*/
                   }
                 / { value: string     /** A pre-compiled JavaScript string containing the code. This happens when we're on the server,
                                           or when the code has been received from the server.*/
                   }

/*
 TODO:

 For better security (and performance?), we should replace the [value] case with the following

{ function: string;                          //The identifier of a toplevel function
  args:     list( {deserialize: (ty, string)}//Non-optimized case: we should perform full deserialization
                / {parse: string}            //Optimized case: we only need to deserialize using JSON.parse
                / {ident: string}            //Optimal case: the argument is already on the client
                )
*/

//TODO: Rename [xhtml_event] to Xhtml.event_handler
//TODO: We could possibly renormalize to always have [expr] on the client and [value] on the server. I'm not sure it would be useful, though.

/**
 * @param 'attributes A set of attributes specific to the XML dialect
 */
@opacapi
type xml('attributes,'extensions) =
  { text : string }         /**Text meant to be escaped before any insertion*/
/ { content_unsafe: string } /**Text meant to be inserted without any check or escaping. Absolutely unsafe, of course.*/
/ { fragment : list(xml('attributes,'extensions)) }
/ { namespace : string /** The namespace name */
    tag : string
    args : list(Xml.attribute)
    content : list(xml('attributes,'extensions))
    specific_attributes : option('attributes) }
/ { xml_dialect : option('extensions) }

@opacapi
type Xml.attribute = { namespace:string name:string value:string }

@opacapi
type xhtml_href =
    {constant:string} /**Constant string, no additional check.*/
/   {untyped:string}  /**Untyped string,  go through whitelist checking*/
/   {typed:Uri.uri}   /**Typed structure, we assume that it has already been checked, so no additional check.*/
/   {none}            /**No URI*/

type xhtml_specific_attributes =
  {
        class:list(string)/**The classes of this element.*/
        style:Css.properties /**The style properties of this element*/
        events:list(handle_assoc(xhtml_event)) /**The event handlers associated with this element, as a list of pairs event name (_not_ attribute name) * event handler */
        events_options:list(handle_assoc(list(Dom.event_option)))
        href: xhtml_href/**Possibly a hyperlink.*/
}

/**
 * A precompiled html extract.
 *
 * Note: We keep html and js separate to avoid any premature evaluation of JS by overzealous browsers.
 */
type xhtml_specific_extensions =
{
  html_code_unsafe: string/**The html code. It won't be checked before being inserted, so be sure that it has been checked before. It should not contain any JS code.*/
  js_code_unsafe:   string/**The JS code.*/
}

@opacapi
type xhtml = xml(xhtml_specific_attributes, xhtml_specific_extensions)

@abstract type empty = void
type xmlns_dialect = empty
type xmlns_specific_attributes = empty
/* FIXME: when universal quantification is available, we should
 * have instead
 * type xmlns = forall('attributes,'extensions) xml('attributes,'extensions) */
type xmlns = xml(xmlns_specific_attributes,xmlns_dialect)
type xml_header =
  { version : option(float)
    encoding : option(string)
    standalone : option(bool)
  }
type xml_document =
  { header : xml_header
    element : xmlns
  }

/**
 * {1 Functions exported to the global namespace}
 */

/**
 * The empty fragment of xhtml
 */
empty_xhtml = {fragment = []} : xhtml

/**
 * Convert a data structure to human-readable X(HT)ML
 */
@opacapi
@specialize(Xml.to_xml:xhtml -> xhtml,
            Xml.to_xml:xmlns -> xmlns,
            Xml.create_fragment:list(xhtml) -> xhtml,
            XmlConvert.of_string:string -> xhtml,
            XmlConvert.of_int:int -> xhtml,
            XmlConvert.of_float:float -> xhtml,
            XmlConvert.of_bool:bool -> xhtml,
            XmlConvert.of_void:void -> xhtml)
magicToXml = XmlConvert.of_alpha : 'a -> xml

/**
 * {1 Xmlns interface}
 */

Xmlns =
{{

   /**
    * Convert a xmlns structure to xhtml
    * FIXME: when xmlns is defined as said above, use [to_xhtml(x:xmlns) : xhtml = x]
    */
   to_xhtml(xmlns: xmlns): xhtml = @unsafe_cast(xmlns)

   /**
    * Convert a xmlns structure into a string
    */
   to_string : xmlns -> string = serialize_to_string

   /**
    * Convert a xhtml structure into a xmlns
    * This function returns an option as it may fail
    * when html specific features are used
    */
   of_xhtml(x) : option(xmlns) =
     match x : xhtml with
     | ~{text} -> {some = ~{text}}
     | ~{content_unsafe} -> {some = ~{content_unsafe}}
     | ~{fragment} ->
        match List.map_while_opt(of_xhtml,fragment) with
        | {none} -> {none}
        | {some=fragment} -> {some = ~{fragment}}
        end
     | {xml_dialect = {none}} as v -> {some = v}
     | {xml_dialect = {some=_}} -> {none}
     | ~{namespace tag args content specific_attributes={none}}
     | ~{namespace tag args content specific_attributes={some = {style=[] class=[] events=[] events_options=[] href={none}}}} ->
        match List.map_while_opt(of_xhtml,content) with
        | {none} -> {none}
        | {some=content} ->
           {some = ~{namespace tag args content specific_attributes={none}}}
        end
     | {namespace=_ tag=_ args=_ content=_ specific_attributes=_} -> {none}

   get_children(xml) =
   match xml : xml with
   | { xml_dialect=_ }
   | { text=_ }
   | { content_unsafe=_} -> []
   | { ~fragment } -> List.flatten(List.map(get_children,fragment))
   | { ~content ... } -> content


/*
   get_children_no_ws(x) =
     x |> get_children |> List.filter(x -> not(Xml.is_ws_node(x)),_)
*/

   /**
    * All the intermediate rules for the xmlns parser
    */
   /* identifiers */
   name_start = parser [a-zA-Z_] -> {}
   name_rest = parser [a-zA-Z_\-.0-9] -> {}
   name = parser v=(name_start name_rest*) -> Text.to_string(v)

   open_sign = parser "<" Rule.ws -> {}
   close_sign = parser Rule.ws ">" -> {}
   autoclose = parser Rule.ws "/" close_sign -> {}

   char_ref_raw = parser "&#" v=(v=Rule.natural -> v | "x" v=Rule.hexadecimal_number -> v) ";" -> v
   regroup_bytes =
   | [] -> ""
   | [h1|t] ->
     match (Cactutf.lenbytes(h1),t) with
     | ({some=1},t) -> Cactutf.cons(Cactutf.one_byte(h1)) ^ regroup_bytes(t)
     | ({some=2},[h2|t]) -> Cactutf.cons(Cactutf.two_bytes(h1,h2)) ^ regroup_bytes(t)
     | ({some=3},[h2,h3|t]) -> Cactutf.cons(Cactutf.three_bytes(h1,h2,h3)) ^ regroup_bytes(t)
     | ({some=4},[h2,h3,h4|t]) -> Cactutf.cons(Cactutf.four_bytes(h1,h2,h3,h4)) ^ regroup_bytes(t)
     | _ -> /* something is invalid */ "?" ^ regroup_bytes(t)
   /* the rule parses all the consecutive entities to be able to regroup them later */
   char_ref = parser intl=char_ref_raw+ -> regroup_bytes(intl)
   entity_name = parser "quot" -> "\""
                      | "amp" -> "&"
                      | "apos" -> "\'"
                      | "lt" -> "<"
                      | "gt" -> ">"
   xml_entity = parser "&" s=entity_name ";" -> s
   escape_sequence = parser s=char_ref -> s
                          | s=xml_entity -> s

   /* */
   svalue = parser v=svaluechars* -> Text.to_string(Text.ltconcat(v))
   svaluechars = parser s=escape_sequence -> Text.cons(s)
                      | s=(svaluechar+) -> s
   svaluechar = parser !['&] . -> {}

   dvalue = parser v=dvaluechars* -> Text.to_string(Text.ltconcat(v))
   dvaluechars = parser s=escape_sequence -> Text.cons(s)
                      | s=(dvaluechar+) -> s
   dvaluechar = parser ![\"&] . -> {}

   text = parser v=textchars+ -> Text.to_string(Text.ltconcat(v))
   textchars = parser s=escape_sequence -> Text.cons(s)
                    | s=(textchar+) -> s
                    | s=cdata -> s
   textchar = parser ![<&] . -> {}
   cdata = parser "<![CDATA[" s=((!"]]>" .)*) "]]>" -> s

   /* */
   open_tag =
      parser open_sign namespace=namespace tag=name Rule.ws ->
         ~{namespace tag}
   open_tag_attributes =
      parser nstag=open_tag args=attribute* ->
         ~{nstag args}
   close_tag =
      parser open_sign "/" Rule.ws namespace=namespace tag=name close_sign ->
         ~{namespace tag}

   /* */
   comment = parser "<!--" (!"-->" .)* "-->" -> {}

   /* attributes */
   equal = parser Rule.ws "=" Rule.ws -> {}
   attribute =
      parser n=namespace e=name equal v=arg_value Rule.ws ->
         {namespace=n name=e value=v}
   arg_value = parser "'" s=svalue "'" -> s
                    | "\"" s=dvalue "\"" -> s
   quoted_value(parser_) = parser "'"  v=parser_ "'"  -> v
                                | "\"" v=parser_ "\"" -> v

   /* tag */
   tag = parser comment Rule.ws t=tag -> t
              | v1=open_tag_attributes v2=tail_open_tag {Rule.succeed_if(Xml.matching_tags(v1.nstag,v2.nstag))} ->
                {nstag=~{namespace tag} ~args} = v1
                {~content nstag=_} = v2
                ~{namespace tag args content specific_attributes={none}} : xmlns
   tail_open_tag = parser autoclose -> {content=[] nstag={none}}
                        | close_sign content=node* nstag=close_tag -> ~{nstag={some=nstag} content}

   /* node */
   node = parser tag=tag -> tag
               | text=text -> ~{text}

   /* namespace */
   namespace = parser o=real_namespace? -> o ? ""
   real_namespace = parser t=name Rule.ws ":" -> t

   /* headers */
   document = parser prolog=prolog tag=tag misc* -> {header=prolog element=tag}

   prolog = parser decl=xmldecl? misc* (doctypedecl misc*)? -> decl ? {version = {none} encoding={none} standalone = {none}}
   xmldecl = parser "<?xml" f=versioninfo e=encodingdecl? s=sddecl? Rule.ws "?>" ->
               {version = {some = f}; encoding=e; standalone = s}
   versioninfo = parser Rule.strict_ws "version" equal v={quoted_value(versionnum)} -> v
   versionnum = parser t=("1." [0-9]+) -> Float.of_string(Text.to_string(t))
   encodingdecl = parser Rule.strict_ws "encoding" equal v={quoted_value(encname)} -> v
   encname = parser t=("UTF"~ "-8") -> Text.to_string(t)
                  | t=([A-Za-z] [A-Za-z0-9._\-]*) ->
                     enc = Text.to_string(t)
                     do Log.warning("xmlparser", "xml was declared with encoding {enc}, treating it as utf-8")
                     enc
   sddecl = parser Rule.strict_ws "standalone" equal b={quoted_value(yes_or_no)} -> b
   yes_or_no = parser "yes" -> {true}
                    | "no" -> {false}

   misc = parser comment -> {}
               | Rule.strict_ws -> {}
               | pi -> {}
   pi = parser "<?" s1=pitarget s2=(Rule.strict_ws t=(!"?>" .)* -> t) "?>" -> (s1,Text.ltconcat(s2))
   pitarget = parser !(xml (Rule.strict_ws | "?>")) s=name -> s
   xml = parser "XML"~ -> {}

   /* FIXME */
   doctypedecl = parser "<!DOCTYPE" doctypedecl_inside -> {}
   doctypedecl_inside = parser (![><] .)* ( "<!" doctypedecl_inside -> {}
                                          | ">" -> {}) -> {}

   /**
    * The main functions for parsing
    */
   parser_ = parser Rule.ws tag=tag Rule.ws comment? -> tag
   try_parse(s:string) : option(xmlns) = Parser.try_parse(parser_,s)
   parse_with_outcome(s:string) : outcome(xmlns,string) =
     match try_parse(s) with
     | {none} -> {failure = s}
     | ~{some} -> {success = some}
   try_parse_document(s:string) : option(xml_document) = Parser.try_parse(document,s)

  /**
   * A few utility functions for pattern matching
   */
  match_star_aux(pattern,xmls) =
    rec aux(acc,xmls) =
      match pattern(xmls) with
      | {none} -> (List.rev(acc),xmls)
      | {some=(res,xmls)} -> aux([res|acc],xmls)
    aux([],xmls)
  match_star(pattern,xmls) =
    {some = match_star_aux(pattern,xmls)}
  match_question(pattern,xmls) =
    match pattern(xmls) with
    | {none} -> {some = ({none}, xmls)}
    | {some=(res,xmls)} -> {some = ({some=res},xmls)}
  match_plus(pattern,xmls) =
    match pattern(xmls) with
    | {none} -> none
    | {some=(hd_res,xmls)} ->
        (tl_res,xmls) = match_star_aux(pattern,xmls)
        {some = ([hd_res|tl_res],xmls)}
  match_range(pattern,min,max,xmls) =
    if max < 0 then {none} else
    over(min,acc,xmls) =
      if min <= 0 then
        {some = (List.rev(acc),xmls)}
      else
        {none}
    rec aux(min,max,acc,xmls) =
      if max == 0 then
        over(min,acc,xmls)
      else
        match pattern(xmls) with
        | {none} -> over(min,acc,xmls)
        | {some=(res,xmls)} -> aux(min-1,max-1,[res|acc],xmls)
    aux(min,max,[],xmls)
  match_exact(pattern,number,xmls) =
    match_range(pattern,number,number,xmls)

  /**
   * The default namespace
   */
  default_ns_uri = ""

  serialize_to_string(xmlns: xmlns): string =
    xhtml = to_xhtml(xmlns)
    ~{js_code html_code} = Xhtml.prepare_for_export(default_ns_uri,xhtml,false)
    do @assert(js_code == "")
    html_code

}}

verbatim_expr(_)=""

/**
 * {1 Xml interface}
 */

/**
 * The functions that should go in that module are functions that are available
 * independently of the specificity of your xml
 * Thus, functions like to_string, or parse cannot appear in here
 */
Xml =
  {{
   /**
    * Returns a boolean saying if two tags match
    * The second namespace and tag are optional: they are none when saying <div/>
    */
  matching_tags(nstag1,nstag2o) =
    match nstag2o with
    | {none} -> {true}
    | {some=nstag2} -> nstag1 == nstag2

  create_fragment(fragment : list(xml)) : xml = ~{fragment}
  to_xml : xml -> xml = x -> x

   /**
    * A few functions used by the xml_parser generation pass
    */
  find_attr(args,namespace_,name_) =
    match List.find({~namespace ~name value=_} ->
                      name == name_ && namespace == namespace_, args)
    with
      | {none} -> {none}
      | {some = {~value ... }} -> {some = value}
    end

  /**
   * {2 Rule module}
   */

  Rule = {{
    integer = xml_parser parser v={@toplevel.Rule.integer} -> v
    float = xml_parser parser v={@toplevel.Rule.float} -> v
    string : list(xml) -> option((string,list(xml))) =
    | [~{text}|xmls] -> {some = (text,xmls)}
    | _ -> {none}
    /* more efficient than
     * [ string = xml_parser v=(.*) -> Text.to_string(v) ] */

    of_rule(r) = xml_parser parser v=r -> v

    string_fragment(xmls:list(xml)) =
      match xmls with
      | [~{text}|rest] -> {some = (text,rest)}
      | _ -> {some = ("",xmls)}
  }}

  // conversion from a list to xml + registering auto-magical conversion from list to xml
  @xmlizer(list('a)) list_to_xml(alpha_to_xml, l) =
    create_fragment(List.map(alpha_to_xml, l))

  // conversion from an option to xml + registering auto-magical conversion from list to xml
  @xmlizer(option('a)) option_to_xml(alpha_to_xml, o) =
    Option.switch(alpha_to_xml, <></>, o)

  /**
   *  Fold on every node of the xml
   *  @param the fold function
   *  @param the first element of the fold
   *  @param the xml to fold
   */
  fold(fun:(xml('a, 'b), 'c -> 'c), seed:'c, xml:xml): 'c =
    match xml with
    | { text=_ }
    | { content_unsafe=_ }
    | { xml_dialect=_ } -> seed
    | { ~fragment } -> List.foldl((el, acc -> fold(fun, acc, el) ), fragment, seed)
    | { namespace=_; tag=_; args=_; ~content; specific_attributes=_} as node ->
      res = fun(node, seed)
      List.foldl((el, acc -> fold(fun, acc, el) ), content, res)
    end

  /**
   *  Apply a transformation function to every element of the given xml
   *  @param the mapping function
   *  @param the xml to transform
   */
  map(fun:(xml('a,'b) -> xml('c,'d)), element:xml('a,'b)) : xml('c,'d) =
    rec aux(elt:xml('a,'b)) =
      match elt with
      | { text=_ }
      | { content_unsafe=_ }
      | { xml_dialect=_ } -> fun(elt)
      | { ~fragment } -> {fragment = List.map(aux, fragment) }
      | { ~content ... } as r ->
        content = List.map(aux, content) ;
        fun({r with content=content} <: xml )
    aux(element)

}}

/**
 * {1 Xml_parser interface}
 */

Xml_parser = {{

  flatten_and_discard_whitespace_aux(xml,acc) =
    match xml : xml with
    | ~{text} ->
       match Parser.try_parse(@toplevel.Rule.ws,text) with
      | {none} -> [xml|acc]
      | {some} -> acc
      end
    | ~{fragment} ->
      flatten_and_discard_whitespace_aux_list(fragment,acc)
    | _ -> [xml|acc]
  flatten_and_discard_whitespace_aux_list(xmls,acc) =
    List.foldl(flatten_and_discard_whitespace_aux,xmls,acc)

  flatten_and_discard_whitespace(xml) =
    List.rev(flatten_and_discard_whitespace_aux(xml,[]))

  flatten_and_discard_whitespace_list(xmls) =
    List.rev(flatten_and_discard_whitespace_aux_list(xmls,[]))

  try_parse(parser_,xml) =
    match parser_(flatten_and_discard_whitespace(xml)) with
    | {none} -> none
    | {some=(result,_nodes)} -> {some=result}
}}

/**
 * {1 XmlConvert interface}
 */

/**
 * Create xml representation of some basic type
 */
XmlConvert = {{

  /**
   * Return the xml representation of any value
   */
  of_alpha(value) =
    original_ty = @typeof(value)
    rec aux(value, ty : OpaType.ty) =
      match ty with
      | {TyName_ident = "xml"; ...} | {TyName_ident = "xhtml"; ...} ->
          Magic.id(value)
      | {TyName_ident = "text"; ...} ->
          XmlConvert.of_string(Text.to_string(Magic.id(value)))
      | {TyConst = {TyInt}} -> XmlConvert.of_int(Magic.id(value))
      | {TyConst = {TyFloat}} -> XmlConvert.of_float(Magic.id(value))
      | {TyConst = {TyString}} -> XmlConvert.of_string(Magic.id(value))
      | {TyName_ident = "list";
         TyName_args =
           [{TyName_ident = "xhtml"; TyName_args = (_ : list(OpaType.ty)) }]} ->
          Xml.create_fragment(Magic.id(value))
      | {TyName_args = args; TyName_ident = ident} ->
        OpaValue.todo_magic_container(
          %%BslValue.MagicContainer.xmlizer_get%%,
          ident, args, (ty -> aux(_, ty)),
          aux(_, OpaType.type_of_name(ident, args)),
          value, [])
      | ty ->
        if OpaTypeUnification.is_unifiable(ty, @typeval(list(xhtml))) then
          Xml.create_fragment(Magic.id(value))
        else {text = "Can't make an xml with {ty}"}
    aux(value, original_ty)
  : xml

  /**
   * Return the xml representation of a string
   */
  of_string(text) : xml = ~{text}

  /**
   * Return the xml representation of an integer
   */
  of_int(i) = of_string(Int.to_string(i))

  /**
   * Return the xml representation of a float
   */
  of_float(f) = of_string(Float.to_string(f))

  /**
   * Convert a boolean to a xhtml representation.
   *
   * @return [<>true</>] or [<>false</>]
   */
  of_bool(b: bool)  = of_string(Bool.to_string(b))

  /**
   * Convert [void] to a XHTML representation
   *
   * @return [<>\{\}</>]
   */
  of_void(u) = of_string(Void.to_string(u))

  /**
   * Convert a list of XHTML fragments to a single XHTML fragment
   *
   * @return [<>{beg_symbol}{x_1}{sep_symbol}...{sep_symbol}{x_n}{end_symbol}</>]
   */
  of_list_using(beg_symbol, end_symbol, sep_symbol, l) =
    List.compose((x, y -> <>{x}{y}</>), beg_symbol, end_symbol, sep_symbol, l)

}}

/**
 * {1 Xhtml interface}
 */

/**
 * This module regroups only xhtml specific functions
 * If you want a function that could be defined in Xml instead
 * then define it in Xml and make an alias in this module
 */
Xhtml =
{{
  default_attributes = {style=[] class=[] events=[] events_options=[] href={none}} : xhtml_specific_attributes

  createFragment : list(xhtml) -> xhtml = Xml.create_fragment

  to_xhtml(xhtml_: xhtml) = xhtml_

  /**
   * Convert an XHTML tree to is client-side Dom representation.
   *
   * Some browsers handle CSS in weird and unexpected ways. Consequently, we cannot apply the styles already.
   * Rather, we collect the styles, then store them in a OPA-specific hidden attribute of the Dom representation.
   * We only apply the CSS when putting the Dom inside the browser document.
   */
  to_dom(xhtml: xhtml) = Dom.from_xhtml(xhtml)

  to_text(xhtml: xhtml) =
    rec fold(src, acc) = List.fold((i, a -> a^aux(i, "")), src, acc)
    and aux(x, a) = match x: xhtml with
      | { ~fragment } -> fold(fragment, a)
      | { tag=_; ~content; ... } -> fold(content, a)
      | { text = t} -> t
      | _ -> error("Xhtml.to_text: Not Fully Implemented")
    aux(xhtml, "")

  of_string : string -> xhtml = XmlConvert.of_string
  of_string_unsafe(text:string): xhtml = { content_unsafe = text }

  //Private functions, they should move
  @private
  default_href = sassoc_full("", "href", "javascript:void(0)")
  @private
  default_alt  = sassoc_full("", "alt", ".")
  @private
  sanitized_uri= "javascript:void(0)/*Sanitized URI*/"

  @private
  exists_attr(attr, list: list(Xml.attribute)): bool =
    oracle(i:Xml.attribute) = i.name == attr
    List.exists(oracle, list)

  @private
  find_attr(attr, list: list(string_assoc(string))): option(string) =
    oracle(i:{name:string; namespace: string; value:string}) =
      if i.name == attr then some(i.value) else none
    List.find_map(oracle, list)

  @private
  remove_attr(attr, list: list(string_assoc(string))): list(string_assoc(string)) =
    oracle(i:Xml.attribute) = i.name == attr
    List.remove_p(oracle, list)

  @private
  iter_tell_me_if_i_am_last(f: 'a,bool -> void, l: list('a)):void =
    rec aux =
      | [hd ] -> f(hd, true)
      | [hd | tl] -> do f(hd, false); aux(tl)
      | [] -> void ;
    aux(l)

   _script_start = "\n<script type=\"text/javascript\">//<![CDATA[\n"
   _script_end   = "\n//]]>\n</script>\n"
//   _script_start = "\n<script type=\"text/javascript\">//<![CDATA[\n(function()\{var js_onready = function() \{var element = document.createElement(\"script\");var content = document.createTextNode(\"";
//   _script_end   = "\"); document.body.appendChild(element);}; if (window.addEventListener) window.addEventListener(\"load\", js_onready, false); else if (window.attachEvent) window.attachEvent(\"onload\", js_onready); else window.setTimeout(js_onready, 500);\})()\n//]]>\n</script>\n"



  /**
   * The URI for the XHTML namespace
   */
  ns_uri = "http://www.w3.org/1999/xhtml"
  @private sassoc_full(namespace, name, value) : Xml.attribute = ~{ namespace name value }

  to_string = serialize_to_string
  /**
   * Convert a [xhtml] subtree to a pair of strings containing the html proper and the corresponding JS code.
   *
   * Note that event handlers and inline styles are extracted from the html and inserted as JS code, as this
   * lets us delegate the handling of browser incompatibilities to the JS library. For instance, our JS
   * library can determine dynamically of the browser calls the CSS [float] property as [cssFloat] or [styleFloat].
   * Also, setting event handlers from JS code is both the modern way of doing things, and the orthogonal
   * way of managing extensions to Dom events, e.g. "onmousewheel", "onnewline", "onready", etc.
   *
   * @param namespace_map A map from uris to the its identifier in the serialized xhtml
   *                      used to have a predictable name of a given uri, as is needed for facebook
   *                      (if you don't put <fb:sometag xmlns:fb="..."> but <plop:sometag xmlns:plop="...">
   *                       it doesn't work)
   * @param xhtml A xhtml {e subtree}, anything that can be inserted inside the [head] or the [body] --
   * {e without the tag}. Do not pass anything larger to this function, or the result will be meaningless
   * for some browsers.
   * @return [~{js_code html_code}], where [html_code] contains the complete structure of the subtree
   * (i.e. the tags) and [js_code] contains the event handlers and the style information as a JS
   * string.
   */
  find_assoc(s:string,l:list((string,'a))) : option('a) = (
    match l with
    | [h|t] -> // trying to write a code that should be reasonable compiled by qmlflat
      if h.f1 == s then {some=h.f2} else find_assoc(s,t)
    | _ -> {none}
  )

  @private Buf = Buffer2_private
  prepare_for_export(_default_ns_uri, xhtml: xhtml, style_inline : bool): {js_code: string; html_code:string} =
  (
    html_buffer = Buf.create(1024)//A buffer for storing the HTML source code
    js_buffer   = Buf.create(1024)//A buffer for storing the JS source code -- at the last step, it is inserted in [html_buffer]
    jsappend_event_handler(x: xhtml_event) =
      code = match x with
        | { ~value } -> value
        | { ~expr  } -> FunAction.serialize(expr)
      Buf.add(js_buffer,code)

    /**
     * @param depth The current depth in the tree. Used both for pretty-printing and to insert scripts at the correct place
     */
    rec handle_xhtml(xhtml: xhtml, depth:int) =
      next = depth + 1 //next depth
      match xhtml with
      | ~{ text }            -> Buf.add(html_buffer,String.escape_html(text))
      | ~{ content_unsafe }  -> Buf.add(html_buffer,content_unsafe)
      | ~{ fragment }        -> List.iter(x -> handle_xhtml(x, depth), fragment)
      | ~{ xml_dialect }     ->
        match xml_dialect with
            | {none} -> void
            | {some = ~{js_code_unsafe html_code_unsafe}} ->
                  do Buf.add(html_buffer,html_code_unsafe)
                  Buf.add(js_buffer,js_code_unsafe)
        end
      | ~{ namespace tag args content specific_attributes } ->

          tag =
            if String.is_empty(namespace) then tag else
            namespace ^ ":" ^ tag

          //Start handling the tag itself
          do Buf.add(html_buffer,"<")
          do Buf.add(html_buffer,tag)

          print_arg(~{name namespace=tagns value}) =
            do Buf.add(html_buffer," ")
            do if String.is_empty(tagns) then Buf.add(html_buffer,name)
               else
                 do Buf.add(html_buffer,tagns)
                 do Buf.add(html_buffer,":")
                 Buf.add(html_buffer,name)
            do Buf.add(html_buffer,"=\"")
            do Buf.add(html_buffer,String.escape_html(value))
            Buf.add(html_buffer,"\"")

          //Handle regular attributes
          do List.iter(print_arg,args)

          do match specific_attributes with
             | {none} -> void
             | {some=~{class style events events_options href}} ->
          //Normalize tags
               do (
                 match tag with
                   | "img" ->    //Add a default [alt] attribute to <img> tags that don't have one
                      if not(exists_attr("alt", args))  then print_arg(default_alt)
                   | "a" | "area"  ->    //Transform xhtml-specific attribute [href] into a string
                      // Should match tag_specific_a in opalang/syntax/xml.trx
                     replacement = match href
                      | {none}     ->
                         // Hack around incorrect [Xml.to_xhtml]
                         // TODO: We should rather implement a new, safe Xml.to_xhtml
                         find_attr("href",args)
                      | ~{constant}-> {some = constant}
                      | ~{untyped} -> //Here, insert dynamic filter through uri parser
                         if Uri.is_secure(untyped) then {some = untyped} //URI was accepted, return original URI
                         else {some = sanitized_uri} //URI was rejected, replace by default URI
                      | ~{typed}   -> {some = Uri.to_string(typed)}//Here, insert URI serialization
                     end
                     match replacement with
                      | {none} -> print_arg(default_href) //Add a default [href] attribute to <a> tags that don't have one
                      | ~{some}-> print_arg(sassoc("href", some))
                     end
                   | _ -> void
               )

               (load_events, other_events) = List.partition((a -> match a.name:Dom.event.kind {ready} -> true | _ -> false), events)
               (_,   other_events_options) = List.partition((a -> match a.name:Dom.event.kind {ready} -> true | _ -> false), events_options)
               //Handle events and style: start
               do (if other_events == [] && other_events_options == [] && style == [] then void
                      else  //We need an ID for this node, to be able to attach event handlers
                         id = match find_attr("id", args) with
                            | ~{some} -> some
                            | {none}  ->
                               id = Random.string(32) //Generate a random ID
                               do print_arg(sassoc("id", id))
                               id
                         end
                         //Now, generate jQuery-specific code in the jsbuffer, as a chain of JS dot calls on the item
                         do Buf.add(js_buffer,"\n$('#")
                         do Buf.add(js_buffer,Dom.escape_selector(id))
                         do Buf.add(js_buffer,"')")

                         //Handle style -- generate a call to jQuery function [css]
                         do if style == [] then void
                            else
                              css_as_list = Css_printer.to_xhtml_style(style)
                              if css_as_list != [] then
                                /* if we printed when css_as_list is empty the css({ would not be closed })*/
                                if style_inline // style_inline is used e.g. for emails
                                then
                                  do Buf.add(html_buffer," style=\"")
                                  iter_tell_me_if_i_am_last((~{name value}, last ->
                                    do Buf.add(html_buffer,name)
                                    do Buf.add(html_buffer,":")
                                    do Buf.add(html_buffer,value)
                                    if last then Buf.add(html_buffer,"\"")
                                    else Buf.add(html_buffer,"; ")),
                                    css_as_list
                                  )

                                else
                                  do Buf.add(js_buffer,"\n.css(\{  ")
                                  iter_tell_me_if_i_am_last((~{name value}, last ->
                                    do Buf.add(js_buffer,"'")
                                    do Buf.add(js_buffer,name)
                                    do Buf.add(js_buffer,"': '")
                                    do Buf.add(js_buffer,value)
                                    if last then Buf.add(js_buffer,"'})")
                                    else Buf.add(js_buffer,"', ")),
                                    css_as_list
                                  )

                         //Handle non-load events
                         do List.iter(~{name value} -> //Generate    [.name(function(event({<<serialize_event_handler(value)>>})))]
                            do Buf.add(js_buffer,"\n.opachbind('")
                            do Buf.add(js_buffer,Dom.Event.get_name(name))
                            do Buf.add(js_buffer,"', (function(event)\{")
                            do jsappend_event_handler(value)
                            do Buf.add(js_buffer,"\}))")
                            void,
                            other_events)

                         //Handle non-load events options
                         do List.iter({name=handle value=options} -> //Generate    [.name(function(event({<<serialize_event_handler(value)>>})))]
                            stop_propagation = List.exists(_ == {stop_propagation}, options)
                            prevent_default  = List.exists(_ == {prevent_default},  options)
                            if(stop_propagation || prevent_default) then
                               do Buf.add(js_buffer,"\n\t.bind('")//Note: here, using [bind], which is faster than [opabind] because it doesn't perform JS -> OPA event conversion
                               do Buf.add(js_buffer,Dom.Event.get_name(handle))
                               do Buf.add(js_buffer,"', (function(event)\{")
                               do if stop_propagation then Buf.add(js_buffer,"event.stopPropagation();")
                               do if prevent_default  then Buf.add(js_buffer,"event.preventDefault();")
                               do Buf.add(js_buffer,"\}))")
                               void,
                               other_events_options)

                         //Finally, return args with id
                         void
                 )

                 do List.iter(~{name value} ->
                    match name with
                      | {ready} ->
                              do Buf.add(js_buffer,"\n$(function()\{var event = {JsInterface.default_opa_event};")//In jQuery, the first argument of the callback is [$] itself -- replace by default event
                              do jsappend_event_handler(value)
                              do Buf.add(js_buffer,"\});")
                              void
                      | _ -> error("[Xhtml.prepare_for_export] Internal error in xhtml serialization -- at this stage, all events other than [ready] should have been prepared")
                    end,
                    load_events)

               //Handle events and style: end

               //Handle classes
               do match class with
                  | [] -> void
                  | [name|t] ->
                    do Buf.add(html_buffer," class=\"")
                    do Buf.add(html_buffer,name)
                    do List.iter((name -> do Buf.add(html_buffer," ") Buf.add(html_buffer,name)),t)
                    Buf.add(html_buffer,"\"")

             void

          //Handle children
          do if content == [] && //Auto-close auto-closing tags
                (match tag with
                | "abbr" | "br" | "col" | "img" | "input" | "link" | "meta" | "param" | "hr" | "area" | "embed" -> true
                | _ -> false)
             then
               Buf.add(html_buffer,"/>")
             else
               do if depth == 0 then
                 // saving the current content of the buffer
                 start = Buf.contents(html_buffer)
                 do Buf.reset(html_buffer,1024)
                 // need to first look at the children,
                 // or else we won't have all their namespaces
                 do List.iter(x -> handle_xhtml(x, next), content)
                 content = Buf.contents(html_buffer)
                 do Buf.reset(html_buffer,1024)
                 // putting back everything into the buffer
                 do Buf.add(html_buffer,start)
                 do Buf.add(html_buffer,">")
                 Buf.add(html_buffer,content)
               else
                 do Buf.add(html_buffer,">")
                 List.iter(x -> handle_xhtml(x, next), content)
               do Buf.add(html_buffer,"</")
               do Buf.add(html_buffer,tag)
               do Buf.add(html_buffer,">")
               void
          void
   end

   do handle_xhtml(xhtml, 0)
   //Now, insert the script
   //We surround everything by a CDATA -- which has an effect in xhtml but not in html
   //We replace each '>', which we assume cannot be a javascript token at this place,
   //  (so it happens only in a string) by its utf escaped counterpart
   //  to prevent both accidental termination via '</script>' tag (when CDATA is not
   //  operative as in html) or accidental termination of CDATA, ']]>'.

   js_code =
     str = Buf.contents(js_buffer)
     str = String.replace(">", "\\076", str)
     str
   {js_code = js_code;
    html_code = Buf.contents(html_buffer)}
  )

 /**
  * Convert xhtml to a readable text
  */
  to_readable_string(xhtml: xhtml): string =
  (
    html_buffer = Buf.create(1024)//A buffer for storing the HTML source code
    // indent(n) = Buf.add(html_buffer,String.make(n," "))
    rec handle_xhtml(xhtml: xhtml, depth:int) =
      next = depth + 1 //next depth
      match xhtml with
      | ~{ text }            ->
        Buf.add(html_buffer,text)
      | { content_unsafe=_ }  -> void
      | ~{ fragment }        ->
        List.iter(x -> handle_xhtml(x, depth), fragment)
      | { xml_dialect=_ }     -> void
      | { namespace=_ ~tag ~args ~content ~specific_attributes } ->
        match tag with
        | "img" ->
          match find_attr("alt",args) with
            | {none} -> void
            |~{some} -> do Buf.add(html_buffer,"[") do Buf.add(html_buffer,some) Buf.add(html_buffer,"]")
          end
        | "a"   ->    //Transform xhtml-specific attribute [href] into a string
          match specific_attributes with
            | {none} -> void
            |~{some} ->
              href = match some.href with
                | {none} -> find_attr("href",args)
                | ~{constant}-> {some = constant}
                | ~{untyped} -> //Here, insert dynamic filter through uri parser
                   if Uri.is_secure(untyped) then {some = untyped} //URI was accepted, return original URI
                   else {none}
                | ~{typed}   -> {some = Uri.to_string(typed)}//Here, insert URI serialization
              end
              match href with
                | {~some} -> do Buf.add(html_buffer,"[") do Buf.add(html_buffer,some) do Buf.add(html_buffer," | ") do List.iter(handle_xhtml(_,depth),content) Buf.add(html_buffer,"]")
                | {none} -> List.iter(handle_xhtml(_,depth),content)
              end
          end
        | "h1" | "h2" | "h3" | "h4" | "h5" | "h6" ->
          do Buf.add(html_buffer,"\n") do List.iter(handle_xhtml(_,depth),content) Buf.add(html_buffer,"\n")
        | "div"| "p"| "pre"| "blocknote"| "adress" ->
          do Buf.add(html_buffer,"\n") do List.iter(handle_xhtml(_,depth),content) Buf.add(html_buffer,"\n")
        | "ul"|"ol"|"dl"|"dir"|"menu" ->
          do Buf.add(html_buffer,"\n") do List.iter(handle_xhtml(_,next),content) Buf.add(html_buffer,"\n")
        | "li"|"dt" ->
          do Buf.add(html_buffer,"- ") do List.iter(handle_xhtml(_,depth),content) Buf.add(html_buffer,"\n")
        | "br" ->
          Buf.add(html_buffer,"\n\n")
        | "hr" -> Buf.add(html_buffer,"\n---------------------------\n")
        | "b" | "i" | "span" | "acronym" | "cite" | "q" | "sup" | "sub" | "strong" | "em"
        | "del" | "ins" | "dfn" | "kbd"->
          List.iter(handle_xhtml(_,depth),content)
        | "html" | "body" ->
          List.iter(handle_xhtml(_,depth),content)
        | _ -> void
        end
    end
    do handle_xhtml(xhtml, 0)
    Buf.contents(html_buffer)
  )

  /**
    * Same with xhtml fields instead of string
    */
  prepare_for_export_as_xml_blocks(xhtml: xhtml) =
    ~{html_code js_code} =  prepare_for_export(ns_uri,xhtml,false)
    html = of_string_unsafe(html_code)
    js   = of_string_unsafe(js_code)
    ~{html js}

  serialize_to_string(xhtml: xhtml): string =
  (
    ~{js_code html_code} = prepare_for_export(ns_uri,xhtml,false)
    if String.is_empty(js_code) then html_code
    else
      String.flatten([html_code,_script_start,js_code,_script_end])
  )

  serialize_as_standalone_html(xhtml: xhtml): string =
    {js_code=_ ~html_code} = prepare_for_export(ns_uri,xhtml,true)
    html_code

  /**
   * Precompile a html fragment into a form that will be faster to transmit and insert.
   *
   * @return a dialect of html designed for this purpose
   */
  precompile(xhtml: xhtml): xhtml =
   {html_code=html_code_unsafe js_code=js_code_unsafe} = prepare_for_export(ns_uri,xhtml,false)
   {xml_dialect = some(~{html_code_unsafe js_code_unsafe})}


  /**
   * Perform the finalization of the js by encapsulation in a secured script construction
   * to be used with [prepare_for_xhtml_export]
   */
  finalize_js_inline(js:xhtml):xhtml =
    {fragment = [of_string_unsafe(_script_start), js, of_string_unsafe(_script_end)]}

  /**
   * Perform the final compilation of a html fragment.
   *
   * You should never need this function, except if you're tweaking the generation of the original web page.
   * @return a string fit to be sent to the browser
   */
  compile(xhtml: xhtml): xhtml =
     { content_unsafe = serialize_to_string(xhtml) }

  // Should put binds on the first encountred element
  add_binds(list : list(handle_assoc(xhtml_event)), o : xhtml) = match o with
    | { namespace=_ tag=_ args=_ ~specific_attributes content=_ } as r ->
      attr = Option.default(default_attributes,specific_attributes)
      attr = {attr with events= list ++ attr.events}
      @opensums({r with specific_attributes={some=attr}}) : xhtml
    | _ -> error("add_binds: not fully implemented")

  @private id_attr = "id"

  /**
   * Get the main id of the xhtml value
   * Will fail if no id or if several id are possible
   */
  get_id(x):option(string)=
    match x : xhtml
    {fragment=[x]} -> get_id(x)
    {~args ...} -> find_attr(id_attr,args)
    _ -> none
    end

  /**
   * Add an id to the xhtml when it is not already defined,
   * When the future position of the id is not clear (several possible node), it encapsulated everything in a div
   */
  add_id(id,x:xhtml):xhtml =
    id = id ? Random.string(16)
    // aux(id, x) with
    rec aux(id,x)=
    match x : xhtml
    {fragment=[x]} -> aux(id,x)
    {text=_}{content_unsafe=_} -> <div id={id}>{x}</div>
    {~args namespace=_ tag=_ content=_ specific_attributes=_} as x->
      args = if exists_attr(id_attr,args) then args
             else [{name=id_attr namespace="" value=id}|args]
      @opensums({x with ~args})
    _ -> <div id={id}>{x}</div>
    end
    aux(id,x)

  @private add_class(value: string, x:xhtml):xhtml =
    rec aux(value,x)=
    match x : xhtml
    {fragment=[x]} -> aux(value,x)
    {text=_}{content_unsafe=_} -> <div class="{value}">{x}</div>
    {args=_ namespace=_ tag=_ content=_ ~specific_attributes} as x ->
      specific_attributes = specific_attributes ? default_attributes
      specific_attributes = some({ specific_attributes with class = specific_attributes.class ++ [value] })
      @opensums({x with ~specific_attributes})
    _ -> <div class="{value}">{x}</div>
    end
    aux(value,x)

  @private add_href(value: string, x:xhtml):xhtml =
    rec aux(value,x)=
    match x : xhtml
    {fragment=[x]} -> aux(value,x)
    {args=_ namespace=_ tag=_ content=_ ~specific_attributes} as x ->
      specific_attributes = specific_attributes ? default_attributes
      specific_attributes = some({ specific_attributes with href = {untyped=value} })
      @opensums({x with ~specific_attributes})
    _ -> x
    end
    aux(value,x)

  @private add_style_from_string(value: string, x:xhtml):xhtml =
    rec aux(value,x)=
    match x : xhtml
    {fragment=[x]} -> aux(value,x)
    {args=_ namespace=_ tag=_ content=_ ~specific_attributes} as x ->
      aux2(acc, s) =
        match String.explode(":", s)
        [k,v] ->
          key = String.strip(k)
          value = String.strip(v)
          [{not_typed=(key, value)}|acc]
        _ -> acc
        end
      styles = List.fold_left(aux2, [], String.explode(";", value))
      specific_attributes = specific_attributes ? default_attributes
      specific_attributes = some({ specific_attributes with style = (specific_attributes.style ++ styles) })
      @opensums({x with ~specific_attributes})
    _ -> x
    end
    aux(value,x)

  @private gen_add_attribute(name: string, value: string, x:xhtml, append:bool):xhtml =
    match name
    | "class" -> add_class(value, x)
    | "href" -> add_href(value, x)
    | "style" -> add_style_from_string(value, x)
    | _ ->
      rec aux(x)=
      match x : xhtml
      {fragment=[x]} -> aux(x)
      {~args namespace=_ tag=_ content=_ specific_attributes=_} as x->
        args = match find_attr(name,args) with
               {some=val} ->
                 if not(append) then args
                 else
                   value = "{val} {value}"
                   args = remove_attr(name,args)
                   [{~name namespace="" ~value}|args]
               {none} -> [{~name namespace="" ~value}|args]
        @opensums({x with ~args})
      _ -> x
      end
      aux(x)

  /**
   * Add an attribute to an xhtml node if not already defined
   */
  add_attribute_unsafe(name: string, value: string, x:xhtml):xhtml =
    gen_add_attribute(name, value, x, false)

  /**
   * Update (by appending) an attribute to an xhtml node, add it if not already present
   */
  update_attribute_unsafe(name: string, value: string, x:xhtml):xhtml =
    gen_add_attribute(name, value, x, true)

  /**
   * Set an attribute to an xhtml node. Replace if already_exists
   */
  set_attribute_unsafe(name: string, value: string, x:xhtml):xhtml =
    // aux(id, x) with
    rec aux(x)=
    match x : xhtml
    {fragment=[x]} -> aux(x)
    {~args namespace=_ tag=_ content=_ specific_attributes=_} as x->
      args =
        l = remove_attr(name,args)
        [{~name namespace="" ~value}|l]
      @opensums({x with ~args})
    _ -> x
    end
    aux(x)

   /**
   * Remove an attribute from an xhtml node.
   */
  remove_attribute(name: string, x:xhtml):xhtml =
    // aux(id, x) with
    rec aux(x)=
    match x : xhtml
    {fragment=[x]} -> aux(x)
    {~args namespace=_ tag=_ content=_ specific_attributes=_} as x->
      args = remove_attr(name,args)
      @opensums({x with ~args})
    _ -> x
    end
    aux(x)

  /**
   * Add a title attribute to an xhtml node.
   * No verification on wether the xhtml supports title attribute is made
   */
  add_title(t:string, x:xhtml) : xhtml = Xhtml.add_attribute_unsafe("title", t, x)

  /**
   * Add/Update ths class attribute of an xhtml node, by appending a certain class.
   * No verification on wether the xhtml supports class attribute is made
   */
  update_class(c:string, x:xhtml) : xhtml = Xhtml.update_attribute_unsafe("class", c, x)

  /**
   * Add style to the xhtml (added to pre-exiting style)
   * When the future position of the style is not clear (several possible node), it encapsulated everything in a div
   */
  add_style(style,x):xhtml =
   match x : xhtml
    {fragment=l} -> {fragment=List.map(add_style(style,_),l)}
    {text=_}{content_unsafe=_} -> <div style={style}>{x}</div>
    {args=_ namespace=_ tag=_ content=_ specific_attributes=sa} as x->
      sa = sa ? default_attributes
      style = style ++ sa.style
      specific_attributes = some({sa with ~style})
      @opensums({x with ~specific_attributes})
    _ -> <div style={style}>{x}</div>

  /**
   * Add a onready event the xhtml
   * NEED TO DETAIL BEHAVIOR IF onready ALREADY EXISTING
   * DOES NOT WORK ON SERVER SIDE UNTIL CLOSURE SERIALIZATION IS WORKING AND USED ON XHTML
   */
  add_onready(f,x):xhtml =
   match x : xhtml
    {content_unsafe=_}
    {text=_} -> <div onready={f}>{x}</div>
    {fragment=[]} -> <div onready={f}></div>
    {fragment=[x|l]} -> x = add_onready(f,x)
                        {fragment=[x|l]}
    {args=_ namespace=_ tag=_ content=_ specific_attributes=sa} as x->
      sa = sa ? default_attributes
      events = [{name={ready} value={expr=f}}|sa.events]
      specific_attributes = some({sa with ~events})
      @opensums({x with ~specific_attributes})
    _ -> <div onready={f}>{x}</div>

  /**
   * Serializer for xhtml data structures.
   * Provides a standard serialization but on server side,
   * unserialization checks and replaces unsafe fields by default
   * values.
   */
  @both_implem @serializer(xhtml) serializer =
    ximpl = OpaType.implementation(@typeval(xhtml))
    {
      f1 = OpaSerialize.partial_serialize_options(_, ximpl, _)
      f2 = json -> @sliced_expr({
        client = OpaSerialize.finish_unserialize(json, ximpl)

        server =
          check_args =
            List.map({namespace=_ ~name ~value} as a ->
              match String.has_prefix("on", name)
              | {true} ->
                do Log.warning("Xhtml",
"Attribute {name} can be an event handler and contains an unsafe string :
{value}
Replaced by a default value.")
                {a with value="/*unsafe attribute from a client*/"}
              | _ -> a
              , _)
          check_sargs({class=_ style=_ ~events events_options=_ href=_} as a) =
            { a with events = List.map(
              | ~{name value=~{value}} ->
                do Log.warning("Xhtml",
"Receiving from a client an unsafe specific attribute {name} :
{value}
Replaced by a default value.")
                ~{name value={value="/*unsafe specific attribute from a client*/"}}
              | _ as a -> a
              , events)
            }
          Option.map(
            | ~{content_unsafe} ->
              do Log.warning("Xhtml",
"Receiving from client unsafe content of xhtml :
{content_unsafe}.
Replaced by a default value.")
              {text = "unsafe content from a client"} : xhtml
            | {namespace=_ tag=_ ~args content=_ ~specific_attributes} as e->
              @opensums({e with args=check_args(args) specific_attributes=Option.map(check_sargs, specific_attributes)}) : xhtml
            | _ as safe -> safe
            ,  OpaSerialize.finish_unserialize(json, ximpl))
        })
    }

}}

/* Functions used by xml pattern matching */
@opacapi Xml_find_attr = Xml.find_attr
@opacapi Xml_match_star = Xmlns.match_star
@opacapi Xml_match_plus = Xmlns.match_plus
@opacapi Xml_match_question = Xmlns.match_question
@opacapi Xml_match_number = Xmlns.match_exact
@opacapi Xml_match_range = Xmlns.match_range

// Cannot be in Uri.uri module due to dependencies on this package
@xmlizer(Uri.uri) uri_to_xml(u : Uri.uri) =
  <>{"{u}"}</>