From 9d38076e9a1dc49faec13596a2f707269c2a0ad7 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 28 Nov 2012 16:56:45 -0500
Subject: Allow any FFI module to declare new HTML tags

---
 demo/more/grid.ur      | 26 +++++++++++++-------------
 demo/more/grid.urs     |  8 ++++----
 demo/more/out/grid.css |  8 ++++----
 demo/subforms.ur       |  6 +++---
 doc/manual.tex         |  6 ++++++
 src/monoize.sml        |  4 ++--
 src/urweb.grm          |  2 +-
 tests/ffitag.ur        |  3 +++
 tests/ffitag.urp       |  4 ++++
 tests/tagffi.urs       |  1 +
 10 files changed, 41 insertions(+), 27 deletions(-)
 create mode 100644 tests/ffitag.ur
 create mode 100644 tests/ffitag.urp
 create mode 100644 tests/tagffi.urs

diff --git a/demo/more/grid.ur b/demo/more/grid.ur
index 9691442c..041115e9 100644
--- a/demo/more/grid.ur
+++ b/demo/more/grid.ur
@@ -40,10 +40,10 @@ functor Make(M : sig
 
                  val pageLength : option int
              end) = struct
-    style tabl
-    style tr
-    style th
-    style td
+    style tab
+    style row
+    style header
+    style data
     style agg
 
     fun make (row : M.row) [input] [filter] (m : colMeta' M.row input filter) : transaction input = m.Project row
@@ -122,13 +122,13 @@ functor Make(M : sig
          M.folder M.cols grid.Cols grid.Filters row
 
     fun render (grid : grid) = <xml>
-      <table class={tabl}>
-        <tr class={tr}>
+      <table class={tab}>
+        <tr class={row}>
           <th/> <th/> <th><button value="No sort" onclick={fn _ => set grid.Sort None}/></th>
           {@mapX2 [fst3] [colMeta M.row] [tr]
             (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
                              data (meta : colMeta M.row p) =>
-                <xml><th class={th}>
+                <xml><th class={header}>
                   {case (meta.Handlers data).Sort of
                        None => txt (meta.Handlers data).Header
                      | sort => <xml><button value={(meta.Handlers data).Header}
@@ -185,7 +185,7 @@ functor Make(M : sig
                                       cols <- makeAll grid.Cols row';
                                       set colsS cols
                           in
-                              <xml><tr class={tr}>
+                              <xml><tr class={row}>
                                 <td>
                                   <dyn signal={b <- signal grid.Selection;
                                                return (if b then
@@ -213,18 +213,18 @@ functor Make(M : sig
                                              return (@mapX3 [fst3] [colMeta M.row] [snd3] [_]
                                                       (fn [nm :: Name] [t :: (Type * Type * Type)]
                                                                        [rest :: {(Type * Type * Type)}]
-                                                                       [[nm] ~ rest] data meta v =>
-                                                          <xml><td class={td}>
+                                                                       [[nm] ~ rest] dat meta v =>
+                                                          <xml><td class={data}>
                                                             <dyn signal={b <- signal ud;
                                                                          return (if b then
-                                                                                     (meta.Handlers data).Edit v
+                                                                                     (meta.Handlers dat).Edit v
                                                                                  else
-                                                                                     (meta.Handlers data).Display
+                                                                                     (meta.Handlers dat).Display
                                                                                                          v)}/>
                                                             <dyn signal={b <- signal ud;
                                                                          if b then
                                                                              valid <-
-                                                                             (meta.Handlers data).Validate v;
+                                                                             (meta.Handlers dat).Validate v;
                                                                              return (if valid then
                                                                                          <xml/>
                                                                                      else
diff --git a/demo/more/grid.urs b/demo/more/grid.urs
index e47e4139..32f6af15 100644
--- a/demo/more/grid.urs
+++ b/demo/more/grid.urs
@@ -49,9 +49,9 @@ functor Make(M : sig
     val showSelection : grid -> source bool
     val selection : grid -> signal (list M.row)
 
-    style tabl
-    style tr
-    style th
-    style td
+    style tab
+    style row
+    style header
+    style data
     style agg
 end
diff --git a/demo/more/out/grid.css b/demo/more/out/grid.css
index 7903b673..3563123b 100644
--- a/demo/more/out/grid.css
+++ b/demo/more/out/grid.css
@@ -1,16 +1,16 @@
-.Grid1_tabl {
+.Grid1_tab {
         border-style: solid
 }
 
-.Grid1_th {
+.Grid1_header {
         border-style: solid
 }
 
-.Grid1_tr {
+.Grid1_row {
         border-style: solid
 }
 
-.Grid1_td {
+.Grid1_data {
         border-style: solid
 }
 
diff --git a/demo/subforms.ur b/demo/subforms.ur
index 71bd1e82..62e3cc87 100644
--- a/demo/subforms.ur
+++ b/demo/subforms.ur
@@ -13,7 +13,7 @@ fun sub r =
         </body></xml>
     end
 
-fun subforms n =
+fun subfrms n =
     if n <= 0 then
         <xml/>
     else
@@ -22,13 +22,13 @@ fun subforms n =
             <hidden{#Num} value={show n}/>
             <li>{[n]}: <textbox{#Text}/></li>
           </entry>
-          {subforms (n - 1)}
+          {subfrms (n - 1)}
         </xml>
 
 fun form n = return <xml><body>
   <form>
     <subforms{#Lines}>
-      {subforms n}
+      {subfrms n}
     </subforms>
     <submit action={sub}/>
   </form>
diff --git a/doc/manual.tex b/doc/manual.tex
index 0dd65afb..b8494070 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -2482,6 +2482,12 @@ It is possible to write JavaScript FFI code that interacts with the functional-r
 \item It is possible to use the more standard ``IDs and mutation'' style of JavaScript coding, though that style is unidiomatic for Ur/Web and should be avoided wherever possible.  Recall the abstract type $\mt{id}$ and its constructor $\mt{fresh}$, which can be used to generate new unique IDs in Ur/Web code.  Values of this type are represented as strings in JavaScript, and a function \cd{fresh()} is available to generate new unique IDs.  Application-specific ID generation schemes may cause bad interactions with Ur/Web code that also generates IDs, so the recommended approach is to produce IDs only via calls to \cd{fresh()}.  FFI code shouldn't depend on the ID generation scheme (on either server side or client side), but it is safe to include these IDs in tag attributes (in either server-side or client-side code) and manipulate the associated DOM nodes in the standard way (in client-side code).  Be forewarned that this kind of imperative DOM manipulation may confuse the Ur/Web runtime system and interfere with proper behavior of tags like \cd{<dyn>}!
 \end{itemize}
 
+\subsection{Introducing New HTML Tags}
+
+FFI modules may introduce new tags as values with $\mt{Basis.tag}$ types.  See \texttt{basis.urs} for examples of how tags are declared.  The identifier of a tag value is used as its rendering in HTML.  The Ur/Web syntax sugar for XML literals desugars each use of a tag into a reference to an identifier with the same name.  There is no need to provide implementations (i.e., in C or JavaScript code) for such identifiers.
+
+The onus is on the coder of a new tag's interface to think about consequences for code injection attacks, messing with the DOM in ways that may break Ur/Web reactive programming, etc.
+
 
 \section{Compiler Phases}
 
diff --git a/src/monoize.sml b/src/monoize.sml
index b51c5d77..004f69cc 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3203,7 +3203,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             let
                 fun getTag' (e, _) =
                     case e of
-                        L.EFfi ("Basis", tag) => (tag, [])
+                        L.EFfi (_, tag) => (tag, [])
                       | L.ECApp (e, t) => let
                             val (tag, ts) = getTag' e
                         in
@@ -3215,7 +3215,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                 fun getTag (e, _) =
                     case e of
-                        L.EFfiApp ("Basis", tag, [((L.ERecord [], _), _)]) => (tag, [])
+                        L.EFfiApp (_, tag, [((L.ERecord [], _), _)]) => (tag, [])
                       | L.EApp (e, (L.ERecord [], _)) => getTag' e
                       | _ => (E.errorAt loc "Non-constant XML tag";
                               Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
diff --git a/src/urweb.grm b/src/urweb.grm
index 084cec1e..a45c7ffa 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1608,7 +1608,7 @@ tagHead: BEGIN_TAG                      (let
                                              val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
                                          in
                                              (bt,
-                                              (EVar (["Basis"], bt, Infer), pos))
+                                              (EVar ([], bt, Infer), pos))
                                          end)
        | tagHead LBRACE cexp RBRACE     (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
                                           
diff --git a/tests/ffitag.ur b/tests/ffitag.ur
new file mode 100644
index 00000000..43ec5bf7
--- /dev/null
+++ b/tests/ffitag.ur
@@ -0,0 +1,3 @@
+open Tagffi
+
+fun main () : transaction page = return <xml><body><funky>test</funky></body></xml>
diff --git a/tests/ffitag.urp b/tests/ffitag.urp
new file mode 100644
index 00000000..5c7f5409
--- /dev/null
+++ b/tests/ffitag.urp
@@ -0,0 +1,4 @@
+ffi tagffi
+rewrite all Ffitag/*
+
+ffitag
diff --git a/tests/tagffi.urs b/tests/tagffi.urs
new file mode 100644
index 00000000..87ee01cb
--- /dev/null
+++ b/tests/tagffi.urs
@@ -0,0 +1 @@
+val funky : bodyTag boxAttrs
-- 
cgit v1.2.3