diff options
-rw-r--r-- | src/urweb.grm | 30 | ||||
-rw-r--r-- | tests/delete.ur | 2 | ||||
-rw-r--r-- | tests/update.ur | 2 |
3 files changed, 26 insertions, 8 deletions
diff --git a/src/urweb.grm b/src/urweb.grm index 61e8d179..efa35117 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -150,6 +150,8 @@ fun native_op (oper, e1, e2, loc) = (EApp (e, e2), loc) end +val inDml = ref false + %% %header (functor UrwebLrValsFn(structure Token : TOKEN)) @@ -284,6 +286,8 @@ fun native_op (oper, e1, e2, loc) = | fields of con list | sqlexps of exp list | fsets of (con * exp) list + | enterDml of unit + | leaveDml of unit %verbose (* print summary of errors *) @@ -748,7 +752,7 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) (); (EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc) end) - | LPAREN UPDATE texp SET fsets CWHERE sqlexp RPAREN + | LPAREN enterDml UPDATE texp SET fsets CWHERE sqlexp leaveDml RPAREN (let val loc = s (LPARENleft, RPARENright) @@ -758,7 +762,7 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) in (EApp (e, sqlexp), loc) end) - | LPAREN DELETE FROM texp CWHERE sqlexp RPAREN + | LPAREN enterDml DELETE FROM texp CWHERE sqlexp leaveDml RPAREN (let val loc = s (LPARENleft, RPARENright) @@ -770,6 +774,9 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) | UNDER (EWild, s (UNDERleft, UNDERright)) +enterDml : (inDml := true) +leaveDml : (inDml := false) + texp : SYMBOL (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)) | LBRACE LBRACE eexp RBRACE RBRACE (eexp) @@ -1026,10 +1033,21 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True"), end) | CSYMBOL (let val loc = s (CSYMBOLleft, CSYMBOLright) - val e = (EVar (["Basis"], "sql_exp"), loc) - in - (ECApp (e, (CName CSYMBOL, loc)), loc) - end) + in + if !inDml then + let + val e = (EVar (["Basis"], "sql_field"), loc) + val e = (ECApp (e, (CName "T", loc)), loc) + in + (ECApp (e, (CName CSYMBOL, loc)), loc) + end + else + let + val e = (EVar (["Basis"], "sql_exp"), loc) + in + (ECApp (e, (CName CSYMBOL, loc)), loc) + end + end) | sqlexp EQ sqlexp (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) | sqlexp NE sqlexp (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) diff --git a/tests/delete.ur b/tests/delete.ur index e2109f61..fee63812 100644 --- a/tests/delete.ur +++ b/tests/delete.ur @@ -1,5 +1,5 @@ table t1 : {A : int, B : string, C : float, D : bool} fun main () : transaction page = - () <- dml (DELETE FROM t1 WHERE T.A = 5); + () <- dml (DELETE FROM t1 WHERE A = 5); return <html><body>Deleted.</body></html> diff --git a/tests/update.ur b/tests/update.ur index 49545cc7..6d8060d0 100644 --- a/tests/update.ur +++ b/tests/update.ur @@ -1,5 +1,5 @@ table t1 : {A : int, B : string, C : float, D : bool} fun main () : transaction page = - () <- dml (UPDATE t1 SET B = 'Hi', C = 12.34 WHERE T.A = 5); + () <- dml (UPDATE t1 SET B = 'Hi', C = 12.34 WHERE A = 5); return <html><body>Updated.</body></html> |