summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-08-28 11:49:38 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-08-28 11:49:38 -0400
commit595c8e8d87d9f91e454654c3d7ad9dd49a1bfd93 (patch)
treee3d7638027c062f0d8db6be54b80a47703fc42f4
parent6c18967e19b76d109c49d7c9e34dc8fe2bfb15ad (diff)
SELECTed expressions in ORDER BY
-rw-r--r--lib/basis.lig45
-rw-r--r--src/lacweb.grm18
-rw-r--r--tests/order_by.lac7
3 files changed, 46 insertions, 24 deletions
diff --git a/lib/basis.lig b/lib/basis.lig
index bf8aab33..746651ce 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -15,7 +15,7 @@ con sql_table :: {Type} -> Type
con sql_query :: {{Type}} -> {Type} -> Type
con sql_query1 :: {{Type}} -> {{Type}} -> {Type} -> Type
-con sql_exp :: {{Type}} -> {{Type}} -> Type -> Type
+con sql_exp :: {{Type}} -> {{Type}} -> {Type} -> Type -> Type
con sql_subset :: {{Type}} -> {{Type}} -> Type
val sql_subset : keep_drop :: {({Type} * {Type})}
@@ -35,12 +35,12 @@ val sql_query1 : tables ::: {{Type}}
-> selectedExps ::: {Type}
-> {From : $(fold (fn nm => fn fields :: {Type} => fn acc =>
[nm] ~ acc => [nm = sql_table fields] ++ acc) [] tables),
- Where : sql_exp tables [] bool,
+ Where : sql_exp tables [] [] bool,
GroupBy : sql_subset tables grouped,
- Having : sql_exp grouped tables bool,
+ Having : sql_exp grouped tables [] bool,
SelectFields : sql_subset grouped selectedFields,
SelectExps : $(fold (fn nm => fn t :: Type => fn acc =>
- [nm] ~ acc => [nm = sql_exp grouped tables t] ++ acc) [] selectedExps) }
+ [nm] ~ acc => [nm = sql_exp grouped tables [] t] ++ acc) [] selectedExps) }
-> sql_query1 tables selectedFields selectedExps
type sql_relop
@@ -60,11 +60,11 @@ type sql_direction
val sql_asc : sql_direction
val sql_desc : sql_direction
-con sql_order_by :: {{Type}} -> Type
-val sql_order_by_Nil : tables :: {{Type}} -> sql_order_by tables
-val sql_order_by_Cons : tables ::: {{Type}} -> t ::: Type
- -> sql_exp tables [] t -> sql_order_by tables
- -> sql_order_by tables
+con sql_order_by :: {{Type}} -> {Type} -> Type
+val sql_order_by_Nil : tables ::: {{Type}} -> exps :: {Type} -> sql_order_by tables exps
+val sql_order_by_Cons : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+ -> sql_exp tables [] exps t -> sql_order_by tables exps
+ -> sql_order_by tables exps
type sql_limit
val sql_no_limit : sql_limit
@@ -78,32 +78,39 @@ val sql_query : tables ::: {{Type}}
-> selectedFields ::: {{Type}}
-> selectedExps ::: {Type}
-> {Rows : sql_query1 tables selectedFields selectedExps,
- OrderBy : sql_order_by tables,
+ OrderBy : sql_order_by tables selectedExps,
Limit : sql_limit,
Offset : sql_offset}
-> sql_query selectedFields selectedExps
val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type -> agg ::: {{Type}}
+ -> exps ::: {Type}
-> tab :: Name -> field :: Name
- -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) agg fieldType
+ -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) agg exps fieldType
+
+val sql_exp : tabs ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> rest ::: {Type} -> nm :: Name
+ -> sql_exp tabs agg ([nm = t] ++ rest) t
class sql_injectable
val sql_bool : sql_injectable bool
val sql_int : sql_injectable int
val sql_float : sql_injectable float
val sql_string : sql_injectable string
-val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> t -> sql_injectable t -> sql_exp tables agg t
+val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+ -> sql_injectable t -> t -> sql_exp tables agg exps t
con sql_unary :: Type -> Type -> Type
val sql_not : sql_unary bool bool
-val sql_unary : tables ::: {{Type}} -> agg ::: {{Type}} -> arg ::: Type -> res ::: Type
- -> sql_unary arg res -> sql_exp tables agg arg -> sql_exp tables agg res
+val sql_unary : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> arg ::: Type -> res ::: Type
+ -> sql_unary arg res -> sql_exp tables agg exps arg -> sql_exp tables agg exps res
con sql_binary :: Type -> Type -> Type -> Type
val sql_and : sql_binary bool bool bool
val sql_or : sql_binary bool bool bool
-val sql_binary : tables ::: {{Type}} -> agg ::: {{Type}} -> arg1 ::: Type -> arg2 ::: Type -> res ::: Type
- -> sql_binary arg1 arg2 res -> sql_exp tables agg arg1 -> sql_exp tables agg arg2 -> sql_exp tables agg res
+val sql_binary : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+ -> arg1 ::: Type -> arg2 ::: Type -> res ::: Type
+ -> sql_binary arg1 arg2 res -> sql_exp tables agg exps arg1 -> sql_exp tables agg exps arg2
+ -> sql_exp tables agg exps res
type sql_comparison
val sql_eq : sql_comparison
@@ -113,8 +120,10 @@ val sql_le : sql_comparison
val sql_gt : sql_comparison
val sql_ge : sql_comparison
val sql_comparison : sql_comparison
- -> tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> sql_exp tables agg t -> sql_exp tables agg t
- -> sql_injectable t -> sql_exp tables agg bool
+ -> tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+ -> t ::: Type -> sql_injectable t
+ -> sql_exp tables agg exps t -> sql_exp tables agg exps t
+ -> sql_exp tables agg exps bool
(** XML *)
diff --git a/src/lacweb.grm b/src/lacweb.grm
index 8c6199dd..c6d89bf6 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -101,19 +101,19 @@ fun amend_group loc (gi, tabs) =
fun sql_inject (v, t, loc) =
let
- val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (v, loc)), loc)
+ val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (t, loc)), loc)
in
- (EApp (e, (t, loc)), loc)
+ (EApp (e, (v, loc)), loc)
end
fun sql_compare (oper, sqlexp1, sqlexp2, loc) =
let
val e = (EVar (["Basis"], "sql_comparison"), loc)
val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc)
+ val e = (EApp (e, (EWild, loc)), loc)
val e = (EApp (e, sqlexp1), loc)
- val e = (EApp (e, sqlexp2), loc)
in
- (EApp (e, (EWild, loc)), loc)
+ (EApp (e, sqlexp2), loc)
end
fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
@@ -801,6 +801,12 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True"),
in
(ECApp (e, fident), loc)
end)
+ | CSYMBOL (let
+ val loc = s (CSYMBOLleft, CSYMBOLright)
+ val e = (EVar (["Basis"], "sql_exp"), loc)
+ in
+ (ECApp (e, (CName CSYMBOL, loc)), loc)
+ end)
| sqlexp EQ sqlexp (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
| sqlexp NE sqlexp (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
@@ -837,7 +843,7 @@ hopt : (sql_inject (EVar (["Basis"], "True"),
| HAVING sqlexp (sqlexp)
obopt : (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), dummy),
- (CWild (KRecord (KRecord (KType, dummy), dummy), dummy), dummy)),
+ (CWild (KRecord (KType, dummy), dummy), dummy)),
dummy)
| ORDER BY obexps (obexps)
@@ -845,7 +851,7 @@ obexps : sqlexp (let
val loc = s (sqlexpleft, sqlexpright)
val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), loc),
- (CWild (KRecord (KRecord (KType, loc), loc), loc), loc)),
+ (CWild (KRecord (KType, loc), loc), loc)),
loc)
val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
sqlexp), loc)
diff --git a/tests/order_by.lac b/tests/order_by.lac
index 77dfa541..f2b501c4 100644
--- a/tests/order_by.lac
+++ b/tests/order_by.lac
@@ -6,3 +6,10 @@ val q2 = (SELECT * FROM t1 GROUP BY t1.A ORDER BY t1.A, t1.B)
val q3 = (SELECT t1.B FROM t1
UNION SELECT t1.B FROM t1
ORDER BY t1.B)
+
+val q4 = (SELECT t1.A, t2.D, t1.A < t2.D AS Lt
+ FROM t1, t2
+ ORDER BY Lt)
+val q5 = (SELECT t1.A, t2.D, t1.A < t2.D AS Lt
+ FROM t1, t2
+ ORDER BY t1.A, Lt, t2.D)