summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Benjamin Barenblat <bbaren@mit.edu>2017-01-07 08:38:35 -0500
committerGravatar Benjamin Barenblat <bbaren@mit.edu>2017-01-07 08:38:35 -0500
commit6145d9df05f442e29dfa96a0b8e15ffcc2d683dd (patch)
tree447639a278556e40c0f7a5784ba4b645f80c1187
parent235602373c04aa38b7f8c93e6efbd9276ecc2266 (diff)
parent4bbdbbc72d96567f8c5a1d435beef32d447dec30 (diff)
Merge branch 'upstream' into dfsg_clean20170105+dfsg
-rw-r--r--CHANGELOG9
-rw-r--r--configure.ac3
-rw-r--r--demo/prose84
-rw-r--r--lib/ur/basis.urs7
-rw-r--r--m4/ax_tls.m474
-rw-r--r--src/c/fastcgi.c45
-rw-r--r--src/c/http.c59
-rw-r--r--src/compiler.sml2
-rw-r--r--src/monoize.sml21
-rw-r--r--src/urweb.grm55
-rw-r--r--tests/crud1.html3
-rw-r--r--tests/formid.ur9
-rw-r--r--tests/formid.urs1
-rw-r--r--tests/qualrecord.ur7
-rw-r--r--tests/textarea_placeholder.ur12
-rw-r--r--tests/textarea_placeholder.urs1
16 files changed, 315 insertions, 77 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 20d79590..89fee4f2 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,4 +1,13 @@
========
+20170105
+========
+
+- Allow qualified variable references in record literals
+- Add 'placeholder' attribute for textareas
+- Add more explicit build instructions to main demo
+- Bug fixes
+
+========
20161022
========
diff --git a/configure.ac b/configure.ac
index fdf010b4..c87b37ed 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,4 +1,4 @@
-AC_INIT([urweb], [20161022])
+AC_INIT([urweb], [20170105])
WORKING_VERSION=0
AC_USE_SYSTEM_EXTENSIONS
@@ -12,6 +12,7 @@ AC_PROG_LIBTOOL()
AC_CONFIG_HEADERS([include/urweb/config.h])
AX_PTHREAD([echo >/dev/null], [echo "Your C compiler does not support POSIX threads."; exit 1])
+AX_TLS([echo >/dev/null], [echo "Your C compiler does not support thread-local storage."; exit 1])
AX_CHECK_OPENSSL([echo >/dev/null], [echo "You must install OpenSSL development files."; exit 1])
diff --git a/demo/prose b/demo/prose
index 8637ef68..781eeed5 100644
--- a/demo/prose
+++ b/demo/prose
@@ -1,38 +1,88 @@
-<p><b>Ur/Web</b> is a domain-specific language for programming web applications backed by SQL databases. It is (strongly) statically-typed (like ML and Haskell) and purely functional (like Haskell). <b>Ur</b> is the base language, and the web-specific features of Ur/Web (mostly) come only in the form of special rules for parsing and optimization. The Ur core looks a lot like <a href="http://sml.sourceforge.net/">Standard ML</a>, with a few <a href="http://www.haskell.org/">Haskell</a>-isms added, and kinder, gentler versions added of many features from dependently-typed languages like the logic behind <a href="http://coq.inria.fr/">Coq</a>. The type system is much more expressive than in ML and Haskell, such that well-typed web applications cannot "go wrong," not just in handling single HTTP requests, but across their entire lifetimes of interacting with HTTP clients. Beyond that, Ur is unusual in using ideas from dependent typing to enable very effective metaprogramming, or programming with explicit analysis of type structure. Many common web application components can be built by Ur/Web functions that operate on types, where it seems impossible to achieve similar code re-use in more established statically-typed languages.</p>
+<p><b>Ur/Web</b> is a domain-specific language for programming web applications backed by SQL databases. It is (strongly) statically typed (like ML and Haskell) and purely functional (like Haskell). <b>Ur</b> is the base language, and the web-specific features of Ur/Web (mostly) come only in the form of special rules for parsing and optimization. The Ur core looks a lot like <a href="http://sml.sourceforge.net/">Standard ML</a>, with a few <a href="http://www.haskell.org/">Haskell</a>-isms added, and kinder, gentler versions added of many features from dependently typed languages like the logic behind <a href="http://coq.inria.fr/">Coq</a>. The type system is much more expressive than in ML and Haskell, such that well-typed web applications cannot "go wrong," not just in handling single HTTP requests, but across their entire lifetimes of interacting with HTTP clients. Beyond that, Ur is unusual in using ideas from dependent typing to enable very effective metaprogramming, or programming with explicit analysis of type structure. Many common web application components can be built by Ur/Web functions that operate on types, where it seems impossible to achieve similar code re-use in more established statically typed languages.</p>
-<p>This demo is built automatically from Ur/Web sources and supporting files. If you unpack the Ur/Web source distribution, then the following steps will (if you're lucky) build you a local version of this demo. If you're not lucky, you can consult the beginning of <a href="http://www.impredicative.com/ur/manual.pdf">the manual</a> for more detailed instructions.
+<p>The page you are currently reading is a part of the demo included with the Ur/Web sources and supporting files available from <a href="https://github.com/urweb/urweb">GitHub</a>. The following steps will build a local instance of the demo if you're lucky (and running a Debian-based Linux OS, which actually tend to have Ur/Web packages built in these days). If you're not lucky, you can consult the beginning of <a href="http://www.impredicative.com/ur/manual.pdf">the manual</a> for more detailed instructions.</p>
-<blockquote><pre>./configure
+<h6>Install System Dependencies</h6>
+
+<p>
+<blockquote><pre>sudo apt-get install build-essential \
+ emacs-goodies-el \
+ libgmp-dev \
+ libssl-dev \
+ libpq-dev \
+ libsqlite3-dev \
+ mlton \
+ sqlite3</blockquote></pre></p>
+
+<h6>Build and Install the Ur/Web Framework</h6>
+
+<p><blockquote><pre>./configure
make
sudo make install
-urweb -noEmacs -demo /Demo demo</pre></blockquote></p>
+</pre></blockquote></p>
-<p>The <tt>-demo /Demo</tt> flag says that we want to build a demo application that expects its URIs to begin with <tt>/Demo</tt>. The final argument <tt>demo</tt> gives the path to a directory housing demo files. One of the files in that directory is <tt>prose</tt>, a file describing the different demo pieces with HTML. Some lines of <tt>prose</tt> have the form <tt><i>foo</i>.urp</tt>, naming particular project files (with the extension <tt>.urp</tt>) in that directory.</p>
+<h6>Compile the Demo the Easy Way</h6>
-<p>These project files can also be built separately. For example, you could run
+<p><blockquote><pre>$ urweb -dbms sqlite -db /path_to_db.sqlite -demo /Demo demo
+</blockquote></pre></p>
+
+<p>The <tt>-dbms sqlite</tt> flag indicates that instead of using the default database management system (<a href="https://www.postgresql.org/">PostgreSQL</a>), we wish to use <a href="https://sqlite.org/">SQLite</a> (usually unsuited for production). The <tt>-db</tt> flag allows us to specify the file-system path to our SQLite database. The <tt>-demo /Demo</tt> parameter indicates that we want to build a demo application that expects its URIs to begin with <tt>/Demo</tt>. The final argument <tt>demo</tt> gives the path to a directory housing Ur/Web source files (<tt>.ur</tt>, <tt>.urp</tt>, <tt>.urs</tt>, etc.).
+</p>
+
+<p>
+The following files are created during the compilation process:
+<ul>
+<li><tt>demo/demo.exe</tt>
+<li><tt>demo/out/*</tt>
+<li><tt>demo/demo.sql</tt>
+</ul>
+</p>
+
+<h6>Initialize the Database</h6>
-<blockquote><pre>urweb demo/hello</pre></blockquote>
+<p>
+When we compiled the demo in the last step, a <tt>demo.sql</tt> file was created for us, which contains all the information required to create a database compatible with the demo web app. The command below will provision our SQLite database. To see an example of where a database table is defined in source code, check out <tt>demo/crud1.ur</tt>. Also of interest is the file <tt>demo.urp</tt>, which contains a <tt>database</tt> directive with the PostgreSQL database that the demo web server will try to connect to if database information isn't provided as command-line arguments when the application is compiled.
+
+<blockquote><pre>$ sqlite3 /path/to/database/file &lt;demo/demo.sql
+</blockquote></pre>
+</p>
+
+<h6>Boot the App</h6>
+
+Executing the binary generated above (<tt>demo/demo.exe</tt>) with no arguments will start a single-threaded server listening on port 8080. (To answer the usual first question: the <tt>.exe</tt> prefix has nothing to do with Windows and does not mean that you compiled for the wrong OS!) Pass the flag <tt>-h</tt> to see which options are available on such freshly built binaries.
+</p>
+<p><blockquote><pre>$ demo/demo.exe
+Database connection initialized.
+Listening on port 8080....
+</blockquote></pre>
+Test out <tt>http://localhost:8080/Demo/Demo/main</tt>, which should consist of links to the individual demos after booting the app.</p>
+</p>
-to build the "Hello World" demo application. Whether building the pieces separately or all at once with the <tt>-demo</tt> flag, a standalone web server executable is generated. The <tt>-demo</tt> command line will generate <tt>demo/demo.exe</tt>, and the other command line will generate <tt>demo/hello.exe</tt>. Either can be run with no arguments to start a single-threaded server accepting requests on port 8080. Pass the flag <tt>-h</tt> to see which options are available.</p>
+<h6>Serve the Static Content with a Reverse Proxy</h6>
-<p>The <tt>-demo</tt> version also generates some HTML in a subdirectory <tt>out</tt> of the demo directory. It is easy to set Apache up to serve these HTML files, and to proxy out to the Ur/Web web server for dynamic page requests. This configuration works for me, where <tt>DIR</tt> is the location of an Ur/Web source distribution.
+<p>The <tt>-demo</tt> version also generates some HTML in a subdirectory <tt>out</tt> of the demo directory (e.g. <tt>index.html</tt>). It is easy to set Apache up to serve these HTML files and to proxy out to the Ur/Web web server for dynamic page requests. This configuration works for me, where <tt>DIR</tt> is the location of an Ur/Web source distribution. (You may also need to enable the proxy module with a command like <tt>a2enmod proxy_http</tt>.)
<blockquote><pre>Alias /demo/ "DIR/demo/out/"
ProxyPass /Demo/ http://localhost:8080/Demo/
ProxyPassReverse /Demo/ http://localhost:8080/Demo/</pre></blockquote></p>
-<p>Building the demo also generates a <tt>demo.sql</tt> file, giving the SQL commands to run to define all of the tables and sequences that the applications expect to see. The file <tt>demo.urp</tt> contains a <tt>database</tt> line with the PostgreSQL database that the demo web server will try to connect to.</p>
+<h6>Compile Individually</h6>
+
+<p>These project files can also be built separately. For example, you could run
+
+<blockquote><pre>$ urweb demo/hello
+</pre></blockquote>
-<p>The easiest way to get a demo running locally is probably with this alternate command sequence:
+to build the "Hello World" demo application. Doing so will invite Ur/Web to seek out the various <tt>demo/hello.*</tt> files and, from them, build a binary <tt>demo/hello.exe</tt>. The URL to access the resulting app will be <tt>http://localhost:8080/Hello/main</tt>.
+</p>
-<blockquote><pre>urweb -dbms sqlite -db /path/to/database/file -demo /Demo demo
-sqlite3 /path/to/database/file &lt;demo/demo.sql
-demo/demo.exe</pre></blockquote></p>
+<h6>This File</h6>
+<p>One of the files in the demo directory is named <tt>prose</tt>, a file describing the different demo pieces with HTML. Some lines of <tt>prose</tt> have the form <tt><i>foo</i>.urp</tt>, naming particular project files (with the extension <tt>.urp</tt>) in that directory. These make up the different pages of the tutorial.</p>
-<p>Then you can skip the static content and connect directly to the demo server at <tt>http://localhost:8080/Demo/Demo/main</tt>, which contains links to the individual demos. If you're running the server created just for <tt>hello</tt>, then the URL will be <tt>http://localhost:8080/Hello/main</tt>.</p>
+<h6>Finally, the Demos!</h6>
-<p>The rest of the demo focuses on the individual applications. Follow the links in the lefthand frame to visit the applications, commentary, and syntax-highlighted source code. (An Emacs mode is behind the syntax highlighting.) I recommend visiting the applications in the order listed, since that is the order in which new concepts are introduced.</p>
+<p>The rest of the demo focuses on introducing Ur/Web programming, one feature at a time. Follow the links in the lefthand frame to visit the applications, commentary, and syntax-highlighted source code. (An Emacs mode is behind the syntax highlighting.) I recommend visiting the applications in the order listed, since that is the order in which new concepts are introduced.</p>
hello.urp
@@ -118,7 +168,7 @@ ref.urp
<p>This example shows how to mix the module system with SQL to implement a kind of "abstract data type." The functor <tt>RefFun.Make</tt> takes in a type belonging to the type class of those types that may be included in SQL. The functor output includes an abstract type <tt>ref</tt>, along with operations for working with <tt>ref</tt>s via transactions. In the functor implementation, we see that <tt>ref</tt> is implemented as <tt>int</tt>, treated as primary keys of a SQL table.</p>
-<p>The functor creates a new encapsulated SQL sequence and table on each call. These local relations show up in the automatically-generated SQL file that should be run to prepare the database for use, but they are invisible from client code. We could change the functor to create different SQL relations, without needing to change client code.</p>
+<p>The functor creates a new encapsulated SQL sequence and table on each call. These local relations show up in the automatically generated SQL file that should be run to prepare the database for use, but they are invisible from client code. We could change the functor to create different SQL relations, without needing to change client code.</p>
<p>Note that, in <tt>ref.ur</tt>, the <tt>inj</tt> components of functor arguments are omitted. Since these arguments are type class witnesses, the compiler infers them automatically based on the choices of <tt>data</tt>.</p>
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 8b0d4faa..23896e27 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -947,7 +947,8 @@ val img : bodyTag ([Alt = string, Src = url, Width = int, Height = int,
val form : ctx ::: {Unit} -> bind ::: {Type}
-> [[MakeForm, Form] ~ ctx] =>
- option css_class
+ option id
+ -> option css_class
-> xml ([Form] ++ ctx) [] bind
-> xml ([MakeForm] ++ ctx) [] []
@@ -981,7 +982,7 @@ val hidden : formTag string [] [Data = data_attr, Id = string, Value = string]
val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string, Onchange = transaction unit,
Ontext = transaction unit] ++ boxAttrs ++ inputAttrs)
val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val textarea : formTag string [] ([Rows = int, Cols = int, Onchange = transaction unit,
+val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string, Onchange = transaction unit,
Ontext = transaction unit] ++ boxAttrs ++ inputAttrs)
val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs)
@@ -1091,7 +1092,7 @@ val ccheckbox : cformTag ([Size = int, Source = source bool, Onchange = transact
val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect]
val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] []
-val ctextarea : cformTag ([Rows = int, Cols = int, Source = source string, Onchange = transaction unit,
+val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string, Onchange = transaction unit,
Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
(*** Tables *)
diff --git a/m4/ax_tls.m4 b/m4/ax_tls.m4
new file mode 100644
index 00000000..809b761a
--- /dev/null
+++ b/m4/ax_tls.m4
@@ -0,0 +1,74 @@
+# ===========================================================================
+# http://www.gnu.org/software/autoconf-archive/ax_tls.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+# AX_TLS([action-if-found], [action-if-not-found])
+#
+# DESCRIPTION
+#
+# Provides a test for the compiler support of thread local storage (TLS)
+# extensions. Defines TLS if it is found. Currently knows about GCC/ICC
+# and MSVC. I think SunPro uses the same as GCC, and Borland apparently
+# supports either.
+#
+# LICENSE
+#
+# Copyright (c) 2008 Alan Woodland <ajw05@aber.ac.uk>
+# Copyright (c) 2010 Diego Elio Petteno` <flameeyes@gmail.com>
+#
+# This program is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation, either version 3 of the License, or (at your
+# option) any later version.
+#
+# This program 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 General
+# Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+# As a special exception, the respective Autoconf Macro's copyright owner
+# gives unlimited permission to copy, distribute and modify the configure
+# scripts that are the output of Autoconf when processing the Macro. You
+# need not follow the terms of the GNU General Public License when using
+# or distributing such scripts, even though portions of the text of the
+# Macro appear in them. The GNU General Public License (GPL) does govern
+# all other use of the material that constitutes the Autoconf Macro.
+#
+# This special exception to the GPL applies to versions of the Autoconf
+# Macro released by the Autoconf Archive. When you make and distribute a
+# modified version of the Autoconf Macro, you may extend this special
+# exception to the GPL to apply to your modified version as well.
+
+#serial 11
+
+AC_DEFUN([AX_TLS], [
+ AC_MSG_CHECKING([for thread local storage (TLS) class])
+ AC_CACHE_VAL([ac_cv_tls],
+ [for ax_tls_keyword in __thread '__declspec(thread)' none; do
+ AS_CASE([$ax_tls_keyword],
+ [none], [ac_cv_tls=none ; break],
+ [AC_TRY_COMPILE(
+ [#include <stdlib.h>
+ static void
+ foo(void) {
+ static ] $ax_tls_keyword [ int bar;
+ exit(1);
+ }],
+ [],
+ [ac_cv_tls=$ax_tls_keyword ; break],
+ ac_cv_tls=none
+ )])
+ done
+ ])
+ AC_MSG_RESULT([$ac_cv_tls])
+
+ AS_IF([test "$ac_cv_tls" != "none"],
+ [AC_DEFINE_UNQUOTED([TLS],[$ac_cv_tls],[If the compiler supports a TLS storage class define it to that here])
+ m4_ifnblank([$1],[$1])],
+ [m4_ifnblank([$2],[$2])])
+])
diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c
index cda3e1f6..c37debf7 100644
--- a/src/c/fastcgi.c
+++ b/src/c/fastcgi.c
@@ -1,5 +1,7 @@
#include "config.h"
+#include <assert.h>
+#include <stdint.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
@@ -20,6 +22,8 @@
#include "fastcgi.h"
+#define THREAD_LOCAL __thread
+
extern uw_app uw_application;
typedef struct {
@@ -44,6 +48,21 @@ typedef struct {
int available, used, sock;
} FCGI_Input;
+// The FastCGI request ID corresponding to the request being handled by the
+// current worker thread. (Each worker thread can only handle one request at a
+// time.)
+static THREAD_LOCAL int current_request_id;
+
+// Reads the FastCGI request ID from a FastCGI record. The result is guaranteed
+// to be in the range [0, 2^16); this function returns an int to avoid C type
+// promotion insanity.
+static int fastcgi_request_id(const FCGI_Record* const r) {
+ const int requestid = r->requestIdB1 << 8 | r->requestIdB0;
+ assert(requestid >= 0);
+ assert(requestid <= UINT16_MAX);
+ return requestid;
+}
+
static FCGI_Output *fastcgi_output() {
FCGI_Output *o = malloc(sizeof(FCGI_Output));
@@ -70,7 +89,9 @@ static int fastcgi_send(FCGI_Output *o,
unsigned char type,
unsigned short contentLength) {
o->r.type = type;
- o->r.requestIdB1 = o->r.requestIdB0 = 0;
+ assert(current_request_id <= UINT16_MAX);
+ o->r.requestIdB1 = current_request_id >> 8;
+ o->r.requestIdB0 = current_request_id & 0x000000ff;
o->r.contentLengthB1 = contentLength >> 8;
o->r.contentLengthB0 = contentLength & 255;
return uw_really_send(o->sock, &o->r, sizeof(o->r) - 65535 + contentLength);
@@ -356,6 +377,10 @@ static void *worker(void *data) {
goto done;
}
+ // Save the FastCGI request ID this worker is handling so that fastcgi_send
+ // can include it in its response.
+ current_request_id = fastcgi_request_id(r);
+
if (r->type != FCGI_BEGIN_REQUEST) {
write_stderr(out, "First message is not BEGIN_REQUEST\n");
goto done;
@@ -373,6 +398,15 @@ static void *worker(void *data) {
goto done;
}
+ if (fastcgi_request_id(r) != current_request_id) {
+ write_stderr(out,
+ "Ignoring environment variables for request %d (current"
+ " request has id %d)\n",
+ fastcgi_request_id(r),
+ current_request_id);
+ continue;
+ }
+
if (r->type != FCGI_PARAMS) {
write_stderr(out, "Expected FCGI_PARAMS but got %d\n", r->type);
goto done;
@@ -428,6 +462,15 @@ static void *worker(void *data) {
goto done;
}
+ if (fastcgi_request_id(r) != current_request_id) {
+ write_stderr(out,
+ "Ignoring STDIN for request %d (current request has id"
+ " %d)\n",
+ fastcgi_request_id(r),
+ current_request_id);
+ continue;
+ }
+
if (r->type != FCGI_STDIN) {
write_stderr(out, "Expected FCGI_STDIN but got %d\n", r->type);
goto done;
diff --git a/src/c/http.c b/src/c/http.c
index d186e209..1bc58677 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -322,19 +322,28 @@ static void sigint(int signum) {
exit(0);
}
+union uw_sockaddr {
+ struct sockaddr sa;
+ struct sockaddr_in ipv4;
+ struct sockaddr_in6 ipv6;
+};
+
int main(int argc, char *argv[]) {
// The skeleton for this function comes from Beej's sockets tutorial.
int sockfd; // listen on sock_fd
- struct sockaddr_in6 my_addr;
- struct sockaddr_in6 their_addr; // connector's address information
- socklen_t sin_size;
- int yes = 1, no = 0, uw_port = 8080, nthreads = 1, i, *names, opt;
+ union uw_sockaddr my_addr;
+ union uw_sockaddr their_addr; // connector's address information
+ socklen_t my_size = 0, sin_size;
+ int yes = 1, uw_port = 8080, nthreads = 1, i, *names, opt;
int recv_timeout_sec = 5;
signal(SIGINT, sigint);
signal(SIGPIPE, SIG_IGN);
- my_addr.sin6_addr = in6addr_any; // auto-fill with my IP
+ // default if not specified: IPv4 with my IP
+ memset(&my_addr, 0, sizeof my_addr);
+ my_addr.sa.sa_family = AF_INET;
+ my_addr.ipv4.sin_addr.s_addr = INADDR_ANY; // auto-fill with my IP
while ((opt = getopt(argc, argv, "hp:a:A:t:kqT:")) != -1) {
switch (opt) {
@@ -357,20 +366,17 @@ int main(int argc, char *argv[]) {
break;
case 'a':
- {
- char *buf = alloca(strlen(optarg) + 8);
- strcpy(buf, "::FFFF:");
- strcpy(buf + 7, optarg);
- if (!inet_pton(AF_INET6, buf, &my_addr.sin6_addr)) {
- fprintf(stderr, "Invalid IPv4 address\n");
- help(argv[0]);
- return 1;
- }
+ my_addr.sa.sa_family = AF_INET;
+ if (!inet_pton(AF_INET, optarg, &my_addr.ipv4.sin_addr)) {
+ fprintf(stderr, "Invalid IPv4 address\n");
+ help(argv[0]);
+ return 1;
}
break;
case 'A':
- if (!inet_pton(AF_INET6, optarg, &my_addr.sin6_addr)) {
+ my_addr.sa.sa_family = AF_INET6;
+ if (!inet_pton(AF_INET6, optarg, &my_addr.ipv6.sin6_addr)) {
fprintf(stderr, "Invalid IPv6 address\n");
help(argv[0]);
return 1;
@@ -413,7 +419,7 @@ int main(int argc, char *argv[]) {
names = calloc(nthreads, sizeof(int));
- sockfd = socket(AF_INET6, SOCK_STREAM, 0); // do some error checking!
+ sockfd = socket(my_addr.sa.sa_family, SOCK_STREAM, 0); // do some error checking!
if (sockfd < 0) {
fprintf(stderr, "Listener socket creation failed\n");
@@ -425,15 +431,20 @@ int main(int argc, char *argv[]) {
return 1;
}
- if (setsockopt(sockfd, IPPROTO_IPV6, IPV6_V6ONLY, &no, sizeof(int)) < 0) {
- fprintf(stderr, "Listener IPV6_V6ONLY option resetting failed\n");
- return 1;
+ switch (my_addr.sa.sa_family)
+ {
+ case AF_INET:
+ my_size = sizeof(my_addr.ipv4);
+ my_addr.ipv4.sin_port = htons(uw_port);
+ break;
+
+ case AF_INET6:
+ my_size = sizeof(my_addr.ipv6);
+ my_addr.ipv6.sin6_port = htons(uw_port);
+ break;
}
- my_addr.sin6_family = AF_INET6; // host byte order
- my_addr.sin6_port = htons(uw_port); // short, network byte order
-
- if (bind(sockfd, (struct sockaddr *)&my_addr, sizeof my_addr) < 0) {
+ if (bind(sockfd, &my_addr.sa, my_size) < 0) {
fprintf(stderr, "Listener socket bind failed\n");
return 1;
}
@@ -470,7 +481,7 @@ int main(int argc, char *argv[]) {
}
while (1) {
- int new_fd = accept(sockfd, (struct sockaddr *)&their_addr, &sin_size);
+ int new_fd = accept(sockfd, &their_addr.sa, &sin_size);
if (new_fd < 0) {
qfprintf(stderr, "Socket accept failed\n");
diff --git a/src/compiler.sml b/src/compiler.sml
index 4fe2dfd5..481f04b6 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -687,7 +687,7 @@ fun parseUrp' accLibs fname =
}
in
if accLibs then
- foldr (fn (job', job) => merge (job, job')) job (!libs)
+ foldl (fn (job', job) => merge (job, job')) job (!libs)
else
job
end
diff --git a/src/monoize.sml b/src/monoize.sml
index 86f2b4a5..ddf6cd4c 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3657,9 +3657,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
end
| L.EApp (
- (L.EApp ((L.ECApp (
- (L.ECApp ((L.EFfi ("Basis", "form"), _), _), _),
- (L.CRecord (_, fields), _)), _),
+ (L.EApp ((L.EApp ((L.ECApp (
+ (L.ECApp ((L.EFfi ("Basis", "form"), _), _), _),
+ (L.CRecord (_, fields), _)), _),
+ id), _),
class), _),
xml) =>
let
@@ -3793,6 +3794,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
action
val stt = (L'.TFfi ("Basis", "string"), loc)
+ val (id, fm) = monoExp (env, st, fm) id
val (class, fm) = monoExp (env, st, fm) class
val action = (L'.EStrcat (action,
(L'.ECase (class,
@@ -3806,8 +3808,17 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
result = stt}), loc)), loc)
in
((L'.EStrcat ((L'.EStrcat (strH "<form method=\"post\"",
- (L'.EStrcat (action,
- strH ">"), loc)), loc),
+ (L'.EStrcat ((L'.ECase (id,
+ [((L'.PNone stt, loc),
+ strH ""),
+ ((L'.PSome (stt, (L'.PVar ("id", stt), loc)), loc),
+ (L'.EStrcat (strH " id=\"",
+ (L'.EStrcat ((L'.ERel 0, loc),
+ strH "\""), loc)), loc))],
+ {disc = (L'.TOption stt, loc),
+ result = stt}), loc),
+ (L'.EStrcat (action,
+ strH ">"), loc)), loc)), loc),
(L'.EStrcat (xml,
strH "</form>"), loc)), loc),
fm)
diff --git a/src/urweb.grm b/src/urweb.grm
index 40101056..db5473a6 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -475,10 +475,11 @@ fun patternOut (e : exp) =
| eterm of exp
| etuple of exp list
| rexp of (con * exp) list * bool
+ | rpath of con
| xml of exp
| xmlOne of exp
| xmlOpt of exp
- | tag of (string * exp) * exp option * exp option * exp
+ | tag of (string * exp) * exp option * exp option * exp option * exp
| tagHead of string * exp
| bind of pat * con option * exp
| edecl of edecl
@@ -499,7 +500,7 @@ fun patternOut (e : exp) =
| rpat of (string * pat) list * bool
| ptuple of pat list
- | attrs of exp option * exp option * exp option * exp option * (string * string * exp) list * (con * exp) list
+ | attrs of exp option * exp option * exp option * exp option * exp option * (string * string * exp) list * (con * exp) list
| attr of attr
| attrv of exp
@@ -1151,15 +1152,15 @@ ctuple : capps STAR capps ([capps1, capps2])
| capps STAR ctuple (capps :: ctuple)
rcon : ([])
- | ident EQ cexp ([(ident, cexp)])
- | ident EQ cexp COMMA rcon ((ident, cexp) :: rcon)
+ | rpath EQ cexp ([(rpath, cexp)])
+ | rpath EQ cexp COMMA rcon ((rpath, cexp) :: rcon)
-rconn : ident ([(ident, (CUnit, s (identleft, identright)))])
- | ident COMMA rconn ((ident, (CUnit, s (identleft, identright))) :: rconn)
+rconn : rpath ([(rpath, (CUnit, s (rpathleft, rpathright)))])
+ | rpath COMMA rconn ((rpath, (CUnit, s (rpathleft, rpathright))) :: rconn)
rcone : ([])
- | ident COLON cexp ([(ident, cexp)])
- | ident COLON cexp COMMA rcone ((ident, cexp) :: rcone)
+ | rpath COLON cexp ([(rpath, cexp)])
+ | rpath COLON cexp COMMA rcone ((rpath, cexp) :: rcone)
ident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
| INT (CName (Int64.toString INT), s (INTleft, INTright))
@@ -1567,8 +1568,11 @@ ptuple : pat COMMA pat ([pat1, pat2])
| pat COMMA ptuple (pat :: ptuple)
rexp : DOTDOTDOT ([], true)
- | ident EQ eexp ([(ident, eexp)], false)
- | ident EQ eexp COMMA rexp ((ident, eexp) :: #1 rexp, #2 rexp)
+ | rpath EQ eexp ([(rpath, eexp)], false)
+ | rpath EQ eexp COMMA rexp ((rpath, eexp) :: #1 rexp, #2 rexp)
+
+rpath : path (CVar path, s (pathleft, pathright))
+ | CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
xml : xmlOne xml (let
val pos = s (xmlOneleft, xmlright)
@@ -1606,7 +1610,7 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer)
(EPrim (Prim.String (Prim.Html, "")), pos)),
pos)
in
- (EApp (#4 tag, cdata), pos)
+ (EApp (#5 tag, cdata), pos)
end)
| tag GT xmlOpt END_TAG (let
@@ -1622,6 +1626,9 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer)
if et = "form" then
let
val e = (EVar (["Basis"], "form", Infer), pos)
+ val e = (EApp (e, case #4 tag of
+ NONE => (EVar (["Basis"], "None", Infer), pos)
+ | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
val e = (EApp (e, case #2 tag of
NONE => (EVar (["Basis"], "None", Infer), pos)
| SOME (EPrim (Prim.String (_, s)), _) => (EApp ((EVar (["Basis"], "Some", Infer), pos), parseClass s pos), pos)
@@ -1639,7 +1646,7 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer)
(EApp ((EVar (["Basis"], "entry", Infer), pos),
xmlOpt), pos)
else
- (EApp (#4 tag, xmlOpt), pos)
+ (EApp (#5 tag, xmlOpt), pos)
else
(if ErrorMsg.anyErrors () then
()
@@ -1684,8 +1691,8 @@ tag : tagHead attrs (let
e), pos)
val e = (EApp (e, eo), pos)
- val atts = case #5 attrs of
- [] => #6 attrs
+ val atts = case #6 attrs of
+ [] => #7 attrs
| data :: datas =>
let
fun doOne (kind, name, value) =
@@ -1705,14 +1712,14 @@ tag : tagHead attrs (let
(EApp (e, doOne nv), pos)
end) (doOne data) datas
in
- ((CName "Data", pos), datas') :: #6 attrs
+ ((CName "Data", pos), datas') :: #7 attrs
end
val e = (EApp (e, (ERecord (atts, false), pos)), pos)
val e = (EApp (e, (EApp (#2 tagHead,
(ERecord ([], false), pos)), pos)), pos)
in
- (tagHead, #1 attrs, #2 attrs, e)
+ (tagHead, #1 attrs, #2 attrs, #5 attrs, e)
end)
tagHead: BEGIN_TAG (let
@@ -1724,7 +1731,7 @@ tagHead: BEGIN_TAG (let
end)
| tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
-attrs : (NONE, NONE, NONE, NONE, [], [])
+attrs : (NONE, NONE, NONE, NONE, NONE, [], [])
| attr attrs (let
val loc = s (attrleft, attrsright)
in
@@ -1733,26 +1740,28 @@ attrs : (NONE, NONE, NONE, NONE, [], [])
(case #1 attrs of
NONE => ()
| SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag";
- (SOME e, #2 attrs, #3 attrs, #4 attrs, #5 attrs, #6 attrs))
+ (SOME e, #2 attrs, #3 attrs, #4 attrs, #5 attrs, #6 attrs, #7 attrs))
| DynClass e =>
(case #2 attrs of
NONE => ()
| SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag";
- (#1 attrs, SOME e, #3 attrs, #4 attrs, #5 attrs, #6 attrs))
+ (#1 attrs, SOME e, #3 attrs, #4 attrs, #5 attrs, #6 attrs, #7 attrs))
| Style e =>
(case #3 attrs of
NONE => ()
| SOME _ => ErrorMsg.errorAt loc "Multiple styles specified for tag";
- (#1 attrs, #2 attrs, SOME e, #4 attrs, #5 attrs, #6 attrs))
+ (#1 attrs, #2 attrs, SOME e, #4 attrs, #5 attrs, #6 attrs, #7 attrs))
| DynStyle e =>
(case #4 attrs of
NONE => ()
| SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag";
- (#1 attrs, #2 attrs, #3 attrs, SOME e, #5 attrs, #6 attrs))
+ (#1 attrs, #2 attrs, #3 attrs, SOME e, #5 attrs, #6 attrs, #7 attrs))
| Data xe =>
- (#1 attrs, #2 attrs, #3 attrs, #4 attrs, xe :: #5 attrs, #6 attrs)
+ (#1 attrs, #2 attrs, #3 attrs, #4 attrs, #5 attrs, xe :: #6 attrs, #7 attrs)
| Normal xe =>
- (#1 attrs, #2 attrs, #3 attrs, #4 attrs, #5 attrs, xe :: #6 attrs)
+ (#1 attrs, #2 attrs, #3 attrs, #4 attrs, (case #1 (#1 xe) of
+ CName "Id" => SOME (#2 xe)
+ | _ => #5 attrs), #6 attrs, xe :: #7 attrs)
end)
attr : SYMBOL EQ attrv (case SYMBOL of
diff --git a/tests/crud1.html b/tests/crud1.html
index 92cd1942..b1f34b54 100644
--- a/tests/crud1.html
+++ b/tests/crud1.html
@@ -24,8 +24,7 @@
</table>
<br /><hr /><br />
-
- <form method="post" action="/Demo/Crud1/create">
+<form method="post" action="/Demo/Crud1/create">
<li> A: <input type="text" name="A" /></li>
<li> B: <input type="text" name="B" /></li>
<li> C: <input type="text" name="C" /></li>
diff --git a/tests/formid.ur b/tests/formid.ur
new file mode 100644
index 00000000..c9e3317d
--- /dev/null
+++ b/tests/formid.ur
@@ -0,0 +1,9 @@
+fun handler () = return <xml></xml>
+
+fun main () : transaction page =
+ id <- fresh;
+ return <xml><body>
+ <form id={id}>
+ <submit action={handler}/>
+ </form>
+ </body></xml>
diff --git a/tests/formid.urs b/tests/formid.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/formid.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/qualrecord.ur b/tests/qualrecord.ur
new file mode 100644
index 00000000..4db64e5f
--- /dev/null
+++ b/tests/qualrecord.ur
@@ -0,0 +1,7 @@
+structure M = struct
+ con the_best_name = #Wiggles
+ con the_runner_up = #Beppo
+end
+
+val x : {M.the_best_name : int, A : int, M.the_runner_up : int} =
+ {M.the_best_name = 8, A = 9, M.the_runner_up = 10}
diff --git a/tests/textarea_placeholder.ur b/tests/textarea_placeholder.ur
new file mode 100644
index 00000000..b328f838
--- /dev/null
+++ b/tests/textarea_placeholder.ur
@@ -0,0 +1,12 @@
+fun lame _ = return <xml/>
+
+fun main () =
+ s <- source "";
+ return <xml><body>
+ <form>
+ <textarea{#Text} placeholder="Type something here."/>
+ <submit action={lame}/>
+ </form>
+
+ <ctextarea source={s} placeholder="Absolutely don't type something here."/>
+ </body></xml>
diff --git a/tests/textarea_placeholder.urs b/tests/textarea_placeholder.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/textarea_placeholder.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page