From afa00baf57893d90366720a364333d3d86c7089a Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 16 Aug 2008 17:46:26 -0400
Subject: Fields in SQL expressions

---
 lib/basis.lig   | 17 ++++++++++-------
 src/lacweb.grm  | 13 +++++++++++--
 tests/table.lac |  2 +-
 tests/where.lac |  1 +
 4 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/lib/basis.lig b/lib/basis.lig
index e056acee..0e98a53f 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -26,13 +26,16 @@ val sql_query : tables :: {({Type} * {Type})}
         -> sql_query (fold (fn nm => fn selected_unselected :: ({Type} * {Type}) => fn acc => [nm] ~ acc =>
                 [nm = selected_unselected.1] ++ acc) [] tables)
 
-class sql_type
-val sql_bool : sql_type bool
-val sql_int : sql_type int
-val sql_float : sql_type float
-val sql_string : sql_type string
+val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type
+        -> tab :: Name -> field :: Name
+        -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) fieldType
 
-val sql_inject : tables ::: {{Type}} -> t ::: Type -> t -> sql_type t -> sql_exp tables t
+class sql_injectable
+val sql_bool : sql_injectable bool
+val sql_int : sql_injectable int
+val sql_float : sql_injectable float
+val sql_string : sql_injectable string
+val sql_inject : tables ::: {{Type}} -> t ::: Type -> t -> sql_injectable t -> sql_exp tables t
 
 con sql_unary :: Type -> Type -> Type
 val sql_not : sql_unary bool bool
@@ -54,7 +57,7 @@ val sql_gt : sql_comparison
 val sql_ge : sql_comparison
 val sql_comparison : sql_comparison
         -> tables ::: {{Type}} -> t ::: Type -> sql_exp tables t -> sql_exp tables t
-        -> sql_type t -> sql_exp tables bool
+        -> sql_injectable t -> sql_exp tables bool
 
 (** XML *)
 
diff --git a/src/lacweb.grm b/src/lacweb.grm
index 97d620db..aee12028 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -230,6 +230,7 @@ fun sql_unary (oper, sqlexp, loc) =
 %nonassoc TWIDDLE
 %nonassoc DOLLAR
 %left DOT
+%nonassoc LBRACE RBRACE
 
 %%
 
@@ -659,11 +660,11 @@ tname  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLr
 table  : SYMBOL                         ((CName SYMBOL, s (SYMBOLleft, SYMBOLright)),
                                          (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)))
        | SYMBOL AS tname                (tname, (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)))
-       | LBRACE eexp RBRACE AS tname    (tname, eexp)
+       | LBRACE LBRACE eexp RBRACE RBRACE AS tname    (tname, eexp)
 
 tident : SYMBOL                         (CName SYMBOL, s (SYMBOLleft, SYMBOLright))
        | CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
-       | LBRACE cexp RBRACE             (cexp)
+       | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
 
 fident : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
        | LBRACE cexp RBRACE             (cexp)
@@ -683,6 +684,14 @@ sqlexp : TRUE                           (sql_inject (EVar (["Basis"], "True"),
                                                      EVar (["Basis"], "sql_bool"),
                                                      s (FALSEleft, FALSEright)))
 
+       | tident DOT fident              (let
+                                             val loc = s (tidentleft, fidentright)
+                                             val e = (EVar (["Basis"], "sql_field"), loc)
+                                             val e = (ECApp (e, tident), loc)
+                                         in
+                                             (ECApp (e, fident), loc)
+                                         end)
+
        | sqlexp EQ sqlexp               (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
        | sqlexp NE sqlexp               (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
        | sqlexp LT sqlexp               (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
diff --git a/tests/table.lac b/tests/table.lac
index eb84a188..b27874c9 100644
--- a/tests/table.lac
+++ b/tests/table.lac
@@ -8,7 +8,7 @@ val q2 = (SELECT * FROM t1, t2)
 (*val q3 = (SELECT * FROM t1, t1)*)
 val q3 = (SELECT * FROM t1, t1 AS T2)
 
-val q4 = (SELECT * FROM {t1} AS T, t1 AS T2)
+val q4 = (SELECT * FROM {{t1}} AS T, t1 AS T2)
 
 val q5 = (SELECT t1.A FROM t1)
 val q6 = (SELECT t1.B, t1.C, t1.A FROM t1)
diff --git a/tests/where.lac b/tests/where.lac
index ac61d2c6..3854e282 100644
--- a/tests/where.lac
+++ b/tests/where.lac
@@ -8,3 +8,4 @@ val q4 = (SELECT * FROM t1 WHERE {True})
 val q5 = (SELECT * FROM t1 WHERE {1} = {1})
 val q6 = (SELECT * FROM t1 WHERE {"Hi"} < {"Bye"})
 val q7 = (SELECT * FROM t1 WHERE {1} <> {1} AND NOT ({"Hi"} >= {"Bye"}))
+val q8 = (SELECT * FROM t1 WHERE t1.A = {1})
-- 
cgit v1.2.3