# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1218736751 14400
# Node ID 241c9a0e3397ab065b14ccb1256001773f9107f0
# Parent  dd82457fda82018361b71d9a872536bad0d3c1f6
Parsing the simplest SQL query

diff -r dd82457fda82 -r 241c9a0e3397 lib/basis.lig
--- 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]
diff -r dd82457fda82 -r 241c9a0e3397 src/lacweb.grm
--- 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)
diff -r dd82457fda82 -r 241c9a0e3397 src/lacweb.lex
--- 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));
 
diff -r dd82457fda82 -r 241c9a0e3397 tests/table.lac
--- a/tests/table.lac	Thu Aug 14 13:20:29 2008 -0400
+++ b/tests/table.lac	Thu Aug 14 13:59:11 2008 -0400
@@ -1,1 +1,3 @@
 table t : {A : int, B : string, C : float}
+
+val my_query = (SELECT * FROM t)