diff options
| -rw-r--r-- | lib/basis.urs | 3 | ||||
| -rw-r--r-- | src/urweb.grm | 30 | ||||
| -rw-r--r-- | src/urweb.lex | 7 | ||||
| -rw-r--r-- | tests/insert.ur | 2 |
4 files changed, 40 insertions, 2 deletions
diff --git a/lib/basis.urs b/lib/basis.urs index ff5c2163..13bb1de1 100644 --- a/lib/basis.urs +++ b/lib/basis.urs @@ -205,7 +205,8 @@ val dml : dml -> transaction unit val insert : fields ::: {Type} -> sql_table fields - -> $fields + -> $(fold (fn nm (t :: Type) acc => [nm] ~ acc => + [nm = sql_exp [T = fields] [] [] t] ++ acc) [] fields) -> dml val update : changed ::: {Type} -> unchanged ::: {Type} -> changed ~ unchanged diff --git a/src/urweb.grm b/src/urweb.grm index 27a06191..1d47f36c 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -179,6 +179,7 @@ fun native_op (oper, e1, e2, loc) = | TRUE | FALSE | CAND | OR | NOT | COUNT | AVG | SUM | MIN | MAX | ASC | DESC + | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NE | LT | LE | GT | GE %nonterm @@ -279,6 +280,10 @@ fun native_op (oper, e1, e2, loc) = | sqlint of exp | sqlagg of string + | texp of exp + | fields of con list + | sqlexps of exp list + %verbose (* print summary of errors *) %pos int (* positions *) @@ -725,10 +730,35 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) | XML_BEGIN XML_END (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)), (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))), s (XML_BEGINleft, XML_ENDright)) + | LPAREN query RPAREN (query) | LPAREN CWHERE sqlexp RPAREN (sqlexp) + + | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN + (let + val loc = s (LPAREN1left, RPAREN3right) + + val e = (EVar (["Basis"], "insert"), loc) + val e = (EApp (e, texp), loc) + in + if length fields <> length sqlexps then + ErrorMsg.errorAt loc "Length mismatch in INSERT field specification" + else + (); + (EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc) + end) + | UNDER (EWild, s (UNDERleft, UNDERright)) +texp : SYMBOL (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)) + | LBRACE LBRACE eexp RBRACE RBRACE (eexp) + +fields : fident ([fident]) + | fident COMMA fields (fident :: fields) + +sqlexps: sqlexp ([sqlexp]) + | sqlexp COMMA sqlexps (sqlexp :: sqlexps) + idents : ident ([ident]) | ident DOT idents (ident :: idents) diff --git a/src/urweb.lex b/src/urweb.lex index e47546b3..1e7876b4 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -335,6 +335,13 @@ notags = [^<{\n]+; <INITIAL> "ASC" => (Tokens.ASC (pos yypos, pos yypos + size yytext)); <INITIAL> "DESC" => (Tokens.DESC (pos yypos, pos yypos + size yytext)); +<INITIAL> "INSERT" => (Tokens.INSERT (pos yypos, pos yypos + size yytext)); +<INITIAL> "INTO" => (Tokens.INTO (pos yypos, pos yypos + size yytext)); +<INITIAL> "VALUES" => (Tokens.VALUES (pos yypos, pos yypos + size yytext)); +<INITIAL> "UPDATE" => (Tokens.UPDATE (pos yypos, pos yypos + size yytext)); +<INITIAL> "SET" => (Tokens.SET (pos yypos, pos yypos + size yytext)); +<INITIAL> "DELETE" => (Tokens.DELETE (pos yypos, pos yypos + size yytext)); + <INITIAL> {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext)); <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext)); diff --git a/tests/insert.ur b/tests/insert.ur index 58db4ef1..c718fb7e 100644 --- a/tests/insert.ur +++ b/tests/insert.ur @@ -1,5 +1,5 @@ table t1 : {A : int, B : string, C : float, D : bool} fun main () : transaction page = - () <- dml (insert t1 {A = 5, B = "6", C = 7.0, D = True}); + () <- dml (INSERT INTO t1 (A, B, C, D) VALUES (5, "6", 7.0, TRUE)); return <html><body>Inserted.</body></html> |