Mercurial > urweb
changeset 204:241c9a0e3397
Parsing the simplest SQL query
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 14 Aug 2008 13:59:11 -0400 |
| parents | dd82457fda82 |
| children | cb8f69556975 |
| files | lib/basis.lig src/lacweb.grm src/lacweb.lex tests/table.lac |
| diffstat | 4 files changed, 47 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/basis.lig Thu Aug 14 13:20:29 2008 -0400 +++ b/lib/basis.lig Thu Aug 14 13:59:11 2008 -0400 @@ -11,6 +11,15 @@ con sql_table :: {Type} -> Type +(*** Queries *) + +con sql_query :: {{Type}} -> Type + +val sql_query : tables ::: {{Type}} + -> $(fold (fn nm => fn ts => fn acc => [nm] ~ acc => + [nm = sql_table ts] ++ acc) [] tables) + -> sql_query tables + (** XML *) @@ -41,6 +50,8 @@ con xhtml = xml [Html] con page = xhtml [] [] +(*** HTML details *) + con html = [Html] con head = [Head] con body = [Body]
--- a/src/lacweb.grm Thu Aug 14 13:20:29 2008 -0400 +++ b/src/lacweb.grm Thu Aug 14 13:59:11 2008 -0400 @@ -31,8 +31,8 @@ val s = ErrorMsg.spanOf -fun uppercaseFirst "" = "" - | uppercaseFirst s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) +fun capitalize "" = "" + | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) fun entable t = case #1 t of @@ -62,6 +62,8 @@ | NOTAGS of string | BEGIN_TAG of string | END_TAG of string + | SELECT | FROM | AS + %nonterm file of decl list | decls of decl list @@ -120,6 +122,11 @@ | attr of con * exp | attrv of exp + | query of exp + | tables of (con * exp) list + | tname of con + | table of con * exp + %verbose (* print summary of errors *) %pos int (* positions *) %start file @@ -390,6 +397,7 @@ | 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) idents : ident ([ident]) | ident DOT idents (ident :: idents) @@ -488,9 +496,27 @@ attrs : ([]) | attr attrs (attr :: attrs) -attr : SYMBOL EQ attrv ((CName (uppercaseFirst SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv) - +attr : SYMBOL EQ attrv ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv) + attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) | LBRACE eexp RBRACE (eexp) + +query : SELECT STAR FROM tables (let + val loc = s (SELECTleft, tablesright) + in + (EApp ((EVar (["Basis"], "sql_query"), loc), + (ERecord tables, loc)), loc) + end) + +tables : table ([table]) + | table COMMA tables (table :: tables) + +tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) + | LBRACE cexp RBRACE (cexp) + +table : SYMBOL ((CName (capitalize 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)
--- a/src/lacweb.lex Thu Aug 14 13:20:29 2008 -0400 +++ b/src/lacweb.lex Thu Aug 14 13:59:11 2008 -0400 @@ -285,6 +285,10 @@ <INITIAL> "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext)); <INITIAL> "Unit" => (Tokens.KUNIT (pos yypos, pos yypos + size yytext)); +<INITIAL> "SELECT" => (Tokens.SELECT (pos yypos, pos yypos + size yytext)); +<INITIAL> "FROM" => (Tokens.FROM (pos yypos, pos yypos + size yytext)); +<INITIAL> "AS" => (Tokens.AS (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));