From 50fc58e8fc815053950b7b919a75cb363d83f114 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 3 Sep 2011 12:51:05 -0400
Subject: An abstract type of IDs

---
 doc/manual.tex   | 11 +++++++++++
 include/urweb.h  |  2 ++
 lib/js/urweb.js  |  9 +++++++++
 lib/ur/basis.urs | 13 ++++++++-----
 src/c/urweb.c    |  9 +++++++++
 src/monoize.sml  |  1 +
 src/settings.sml |  7 +++++--
 tests/nextid.ur  | 11 +++++++++++
 8 files changed, 56 insertions(+), 7 deletions(-)
 create mode 100644 tests/nextid.ur

diff --git a/doc/manual.tex b/doc/manual.tex
index a3800e17..e6a96c05 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -1983,6 +1983,17 @@ $$\begin{array}{l}
  \mt{val} \; \mt{onMouseup} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit}
 \end{array}$$
 
+\subsubsection{Node IDs}
+
+There is an abstract type of node IDs that may be assigned to \cd{id} attributes of most HTML tags.
+
+$$\begin{array}{l}
+  \mt{type} \; \mt{id} \\
+  \mt{val} \; \mt{fresh} : \mt{transaction} \; \mt{id}
+\end{array}$$
+
+The \cd{fresh} function is allowed on both server and client, but there is no other way to create IDs, which includes lack of a way to force an ID to match a particular string.  The only semantic importance of IDs within Ur/Web is in uses of the HTML \cd{<label>} tag.  IDs play a much more central role in mainstream JavaScript programming, but Ur/Web uses a very different model to enable changes to particular nodes of a page tree, as the next manual subsection explains.  IDs may still be useful in interfacing with JavaScript code (for instance, through Ur/Web's FFI).
+
 \subsubsection{Functional-Reactive Page Generation}
 
 Most approaches to ``AJAX''-style coding involve imperative manipulation of the DOM tree representing an HTML document's structure.  Ur/Web follows the \emph{functional-reactive} approach instead.  Programs may allocate mutable \emph{sources} of arbitrary types, and an HTML page is effectively a pure function over the latest values of the sources.  The page is not mutated directly, but rather it changes automatically as the sources are mutated.
diff --git a/include/urweb.h b/include/urweb.h
index b5692a6d..e0faebf7 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -346,4 +346,6 @@ uw_Basis_bool uw_Basis_currentUrlHasQueryString(uw_context);
 
 void uw_cutErrorLocation(char *);
 
+uw_Basis_string uw_Basis_fresh(uw_context);
+
 #endif
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 1277175d..7f636ef9 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1374,5 +1374,14 @@ function bless(s) {
     return u;
 }
 
+
+// ID generation
+
+var nextId = 0;
+
+function fresh() {
+    return (--nextId).toString();
+}
+
 // App-specific code
 
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 5ca27885..cdd49da9 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -668,12 +668,15 @@ val url : transaction page -> url
 val effectfulUrl : (option queryString -> transaction page) -> url
 val redirect : t ::: Type -> url -> transaction t
 
+type id
+val fresh : transaction id
+
 val dyn : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> [ctx ~ body] => unit
           -> tag [Signal = signal (xml (body ++ ctx) use bind)] (body ++ ctx) [] use bind
 
 val head : unit -> tag [] html head [] []
 val title : unit -> tag [] head [] [] []
-val link : unit -> tag [Id = string, Rel = string, Typ = string, Href = url, Media = string] head [] [] []
+val link : unit -> tag [Id = id, Rel = string, Typ = string, Href = url, Media = string] head [] [] []
 
 val body : unit -> tag [Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit]
                        html body [] []
@@ -686,7 +689,7 @@ con bodyTagStandalone = fn (attrs :: {Type}) =>
                            -> [[Body] ~ ctx] =>
                                  unit -> tag attrs ([Body] ++ ctx) [] [] []
 
-val br : bodyTagStandalone [Id = int]
+val br : bodyTagStandalone [Id = id]
 
 con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
 con mouseEvents = [Onclick = transaction unit, Ondblclick = transaction unit,
@@ -701,8 +704,8 @@ con resizeEvents = [Onresize = transaction unit]
 con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents
 con tableEvents = focusEvents ++ mouseEvents ++ keyEvents
 
-con boxAttrs = [Id = string, Title = string] ++ boxEvents
-con tableAttrs = [Id = string, Title = string] ++ tableEvents
+con boxAttrs = [Id = id, Title = string] ++ boxEvents
+con tableAttrs = [Id = id, Title = string] ++ tableEvents
 
 val span : bodyTag boxAttrs
 val div : bodyTag boxAttrs
@@ -789,7 +792,7 @@ val postType : postBody -> string
 val postData : postBody -> string
 
 con radio = [Body, Radio]
-val radio : formTag string radio [Id = string]
+val radio : formTag string radio [Id = id]
 val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs) radio [] [] []
 
 con select = [Select]
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 2a593767..0f1634e9 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -463,6 +463,8 @@ struct uw_context {
   uw_Basis_postBody postBody;
   uw_Basis_string queryString;
 
+  unsigned nextId;
+
   char error_message[ERROR_BUF_LEN];
 };
 
@@ -532,6 +534,8 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) {
 
   ctx->queryString = NULL;
 
+  ctx->nextId = 0;
+
   return ctx;
 }
 
@@ -608,6 +612,7 @@ void uw_reset_keep_error_message(uw_context ctx) {
   ctx->used_transactionals = 0;
   ctx->script_header = "";
   ctx->queryString = NULL;
+  ctx->nextId = 0;
 }
 
 void uw_reset_keep_request(uw_context ctx) {
@@ -3947,3 +3952,7 @@ void uw_cutErrorLocation(char *s) {
 
   memmove(s, s2+2, strlen(s2+2)+1);
 }
+
+uw_Basis_string uw_Basis_fresh(uw_context ctx) {
+  return uw_Basis_htmlifyInt(ctx, ctx->nextId++);
+}
diff --git a/src/monoize.sml b/src/monoize.sml
index 7849e1cd..9f100a3f 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -219,6 +219,7 @@ fun monoType env =
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "css_class") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "id") => (L'.TFfi ("Basis", "string"), loc)
 
                   | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
diff --git a/src/settings.sml b/src/settings.sml
index 8b376a00..9301e93e 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -155,7 +155,8 @@ val benignBase = basis ["get_cookie",
                         "onKeypress",
                         "onKeyup",
                         "onMousedown",
-                        "onMouseup"]
+                        "onMouseup",
+                        "fresh"]
 
 val benign = ref benignBase
 fun setBenignEffectful ls = benign := S.addList (benignBase, ls)
@@ -278,7 +279,9 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("onKeypress", "uw_onKeypress"),
                           ("onKeyup", "uw_onKeyup"),
                           ("onMousedown", "uw_onMousedown"),
-                          ("onMouseup", "uw_onMouseup")]
+                          ("onMouseup", "uw_onMouseup"),
+
+                          ("fresh", "fresh")]
 val jsFuncs = ref jsFuncsBase
 fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
 fun jsFunc x = M.find (!jsFuncs, x)
diff --git a/tests/nextid.ur b/tests/nextid.ur
new file mode 100644
index 00000000..8120ef0b
--- /dev/null
+++ b/tests/nextid.ur
@@ -0,0 +1,11 @@
+fun main () : transaction page =
+    id1 <- fresh;
+    id2 <- fresh;
+    id3 <- fresh;
+    idS <- source id3;
+    return <xml><body>
+      <span id={id1}>Hi</span> <span id={id2}>there!</span><br/><br/>
+      <dyn signal={idS <- signal idS; return <xml><span id={idS}>Whoa-hoa!</span></xml>}/>
+      <button onclick={id <- fresh; set idS id}/>
+      Source: <dyn signal={idS <- signal idS; return (txt (<xml><span id={idS}>Whoa-hoa!</span></xml> : xbody))}/>
+    </body></xml>
-- 
cgit v1.2.3