changeset 2031:d11a7a9c4a73

New syntactic shorthand for antiquoting subqueries
author Adam Chlipala <adam@chlipala.net>
date Wed, 25 Jun 2014 14:04:13 -0400
parents 6add6d00ef5f
children 884673e5f7d5
files doc/manual.tex src/urweb.grm tests/tags.ur tests/tags.urp
diffstat 4 files changed, 38 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/doc/manual.tex	Sun Jun 15 21:13:12 2014 +0000
+++ b/doc/manual.tex	Wed Jun 25 14:04:13 2014 -0400
@@ -2280,7 +2280,7 @@
   &&& \{\{e\}\} \; \mt{AS} \; \{c\} & \textrm{computed table expression, with computed local name} \\
   \textrm{$\mt{FROM}$ items} & F &::=& T \mid \{\{e\}\} \mid F \; J \; \mt{JOIN} \; F \; \mt{ON} \; E \\
   &&& \mid F \; \mt{CROSS} \; \mt{JOIN} \ F \\
-  &&& \mid (Q) \; \mt{AS} \; t \\
+  &&& \mid (Q) \; \mt{AS} \; t \mid (\{\{e\}\}) \; \mt{AS} \; t \\
   \textrm{Joins} & J &::=& [\mt{INNER}] \\
   &&& \mid [\mt{LEFT} \mid \mt{RIGHT} \mid \mt{FULL}] \; [\mt{OUTER}] \\
   \textrm{SQL expressions} & E &::=& t.f & \textrm{column references} \\
--- a/src/urweb.grm	Sun Jun 15 21:13:12 2014 +0000
+++ b/src/urweb.grm	Wed Jun 25 14:04:13 2014 -0400
@@ -1981,6 +1981,14 @@
                                          in
                                              ([tname], (EApp (e, query), loc))
                                          end)
+       | LPAREN LBRACE LBRACE eexp RBRACE RBRACE RPAREN AS tname   (let
+                                             val loc = s (LPARENleft, RPARENright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_from_query", Infer), loc)
+                                             val e = (ECApp (e, tname), loc)
+                                         in
+                                             ([tname], (EApp (e, eexp), loc))
+                                         end)
        | LPAREN fitem RPAREN            (fitem)
 
 tname  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/tags.ur	Wed Jun 25 14:04:13 2014 -0400
@@ -0,0 +1,23 @@
+table images : { Id : int, Content : blob }
+table tags : { Id : int, Tag : string }
+
+datatype mode = Present | Absent
+type condition = { Tag : string, Mode : mode }
+
+type tag_query = sql_query [] [] [] [Id = int]
+
+fun addCondition (c : condition) (q : tag_query) : tag_query =
+    case c.Mode of
+        Present => (SELECT I.Id AS Id
+                    FROM ({{q}}) AS I
+                      JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]})
+      | Absent => q
+
+fun withConditions (cs : list condition) : tag_query =
+    List.foldl addCondition (SELECT images.Id AS Id FROM images) cs
+
+fun main (cs : list condition) : transaction page =
+    x <- queryX (withConditions cs) (fn r => <xml><li>{[r.Id]}</li></xml>);
+    return <xml><body>
+      {x}
+    </body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/tags.urp	Wed Jun 25 14:04:13 2014 -0400
@@ -0,0 +1,6 @@
+database dbname=test
+sql tags.sql
+rewrite url Tags/*
+
+$/list
+tags