diff options
-rw-r--r-- | lib/basis.lig | 11 | ||||
-rw-r--r-- | src/lacweb.grm | 34 | ||||
-rw-r--r-- | src/lacweb.lex | 4 | ||||
-rw-r--r-- | tests/table.lac | 2 |
4 files changed, 47 insertions, 4 deletions
diff --git a/lib/basis.lig b/lib/basis.lig index b721f775..a7cfd276 100644 --- a/lib/basis.lig +++ b/lib/basis.lig @@ -11,6 +11,15 @@ datatype bool = False | True 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 @@ val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type} -> bind ::: { con xhtml = xml [Html] con page = xhtml [] [] +(*** HTML details *) + con html = [Html] con head = [Head] con body = [Body] diff --git a/src/lacweb.grm b/src/lacweb.grm index 0ca7298d..3920fcf9 100644 --- a/src/lacweb.grm +++ b/src/lacweb.grm @@ -31,8 +31,8 @@ open Source 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 @@ fun entable t = | 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 @@ fun entable t = | 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 @@ 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) idents : ident ([ident]) | ident DOT idents (ident :: idents) @@ -488,9 +496,27 @@ tagHead: BEGIN_TAG (let 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 --git a/src/lacweb.lex b/src/lacweb.lex index 8a9756d1..50fe7f26 100644 --- a/src/lacweb.lex +++ b/src/lacweb.lex @@ -285,6 +285,10 @@ notags = [^<{\n]+; <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 --git a/tests/table.lac b/tests/table.lac index ad67fd19..4c44f857 100644 --- a/tests/table.lac +++ b/tests/table.lac @@ -1 +1,3 @@ table t : {A : int, B : string, C : float} + +val my_query = (SELECT * FROM t) |