[Ur] Hamlet like XML, structured by indentation with tag autoclosing

Fri Jun 26 10:35:30 EDT 2015

Here is an equivalent code of the Sql demo 
(http://impredicative.com/ur/demo/sql.html) example, but with indented 
xml style. It compiles!.

Adding an optional type annotation on "row", in case of typo errors, 
makes the error message shorter and nicer.

(* ------------ *)

table t : { A : int, B : float, C : string, D : bool }
   PRIMARY KEY A

type t_qry_item = {T: { A : int, B : float, C : string, D : bool }}

fun do_list () =
     rows <- queryL (SELECT * FROM t) ;

     return <ixml>
       <table>
         <tr> <th>A</th> <th>B</th> <th>C</th> <th>D</th>

         $foldrmapx {rows} <| {row : t_qry_item}
              <tr>
                  <td>{[row.T.A]}
                  <td>{[row.T.B]}
                  <td>{[row.T.C]}
                  <td>{[row.T.D]}
                  <td><form><submit action={delete row.T.A}
                                    value="Delete"/></form>

       <br/><hr/><br/>
       <form>
         <table>
           <tr> <th>A:</th> <td><textbox{#A}/></td>
           <tr> <th>B:</th> <td><textbox{#B}/></td>
           <tr> <th>C:</th> <td><textbox{#C}/></td>
           <tr> <th>D:</th> <td><checkbox{#D}/></td>
           <tr> <th/> <td><submit action={add} value="Add Row"/></td>
     </ixml>

and add r =
     dml (INSERT INTO t (A, B, C, D)
          VALUES ({[readError r.A]}, {[readError r.B]}, {[r.C]}, {[r.D]}));
     xml <- do_list ();
     return <ixml>
   <body>
     <p>Row added.

     {xml}
</ixml>

and delete a () =
     dml (DELETE FROM t
          WHERE t.A = {[a]});
     xml <- do_list ();
     return <ixml>
<body>
   <p>Row deleted
   {xml}
</ixml>

fun main () =
     xml <- do_list ();
     return <ixml>
<body>
   {xml}
</ixml>

(* ------------------- *)

Since queryL gives a result list with first element at the list bottom, 
I have setup a foldright version and a foldleft one (versions of 
List.mapX with tail recursion) by simply swapping the order of the xml 
combination.

fun ixml_foldlmapx [a] [ctx ::: {Unit}] (f: a -> xml ctx [] []) (li: 
list a): xml ctx [] [] =

    let foldlmapx' li <xml/>

    where fun foldlmapx' (li': list a) (acc: xml ctx [] []) =
         case li' of
           | x :: rest => foldlmapx' rest <xml>{acc}{f x}</xml>
           | _ => acc
    end

fun ixml_foldrmapx [a] [ctx ::: {Unit}] (f: a -> xml ctx [] []) (li: 
list a): xml ctx [] [] =

    let foldrmapx' li <xml/>

    where fun foldrmapx' (li': list a) (acc: xml ctx [] []) =
         case li' of
           | x :: rest => foldrmapx' rest <xml>{f x}{acc}</xml>
           | _ => acc
    end