summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2010-03-16 15:54:35 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2010-03-16 15:54:35 -0400
commita33b1fdbf6ff02d806ac5c563f9274abc57b6a43 (patch)
tree9d33fe703a729a1a6e1317fea053f4a3a646cf52
parent2bdffddbb847cbd620b8be911a1c1cb229187fc2 (diff)
COUNT(col)
-rw-r--r--lib/ur/basis.urs18
-rw-r--r--src/monoize.sml10
-rw-r--r--src/urweb.grm9
-rw-r--r--tests/agg.ur19
-rw-r--r--tests/agg.urp4
5 files changed, 36 insertions, 24 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index ca54bc7b..98e620df 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -454,25 +454,27 @@ val sql_ge : t ::: Type -> sql_binary t t bool
val sql_count : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
-> sql_exp tables agg exps int
-con sql_aggregate :: Type -> Type
+con sql_aggregate :: Type -> Type -> Type
val sql_aggregate : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
- -> t ::: Type
- -> sql_aggregate t -> sql_exp agg agg exps t
- -> sql_exp tables agg exps t
+ -> dom ::: Type -> ran ::: Type
+ -> sql_aggregate dom ran -> sql_exp agg agg exps dom
+ -> sql_exp tables agg exps ran
+
+val sql_count_col : t ::: Type -> sql_aggregate (option t) int
class sql_summable
val sql_summable_int : sql_summable int
val sql_summable_float : sql_summable float
-val sql_avg : t ::: Type -> sql_summable t -> sql_aggregate t
-val sql_sum : t ::: Type -> sql_summable t -> sql_aggregate t
+val sql_avg : t ::: Type -> sql_summable t -> sql_aggregate t t
+val sql_sum : t ::: Type -> sql_summable t -> sql_aggregate t t
class sql_maxable
val sql_maxable_int : sql_maxable int
val sql_maxable_float : sql_maxable float
val sql_maxable_string : sql_maxable string
val sql_maxable_time : sql_maxable time
-val sql_max : t ::: Type -> sql_maxable t -> sql_aggregate t
-val sql_min : t ::: Type -> sql_maxable t -> sql_aggregate t
+val sql_max : t ::: Type -> sql_maxable t -> sql_aggregate t t
+val sql_min : t ::: Type -> sql_maxable t -> sql_aggregate t t
con sql_nfunc :: Type -> Type
val sql_nfunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
diff --git a/src/monoize.sml b/src/monoize.sml
index 5f616c05..8c050719 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -236,7 +236,7 @@ fun monoType env =
(L'.TFfi ("Basis", "string"), loc)
| L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_binary"), _), _), _), _), _), _) =>
(L'.TFfi ("Basis", "string"), loc)
- | L.CApp ((L.CFfi ("Basis", "sql_aggregate"), _), _) =>
+ | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_aggregate"), _), _), _), _) =>
(L'.TFfi ("Basis", "string"), loc)
| L.CApp ((L.CFfi ("Basis", "sql_summable"), _), _) =>
(L'.TRecord [], loc)
@@ -2371,7 +2371,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L.ECApp (
(L.ECApp (
(L.ECApp (
- (L.EFfi ("Basis", "sql_aggregate"), _),
+ (L.ECApp (
+ (L.EFfi ("Basis", "sql_aggregate"), _),
+ _), _),
_), _),
_), _),
_), _),
@@ -2401,6 +2403,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
fm)
end
+ | L.ECApp ((L.EFfi ("Basis", "sql_count_col"), _), _) =>
+ ((L'.EPrim (Prim.String "COUNT"), loc),
+ fm)
+
| L.EFfi ("Basis", "sql_summable_int") => ((L'.ERecord [], loc), fm)
| L.EFfi ("Basis", "sql_summable_float") => ((L'.ERecord [], loc), fm)
| L.ECApp ((L.EFfi ("Basis", "sql_avg"), _), _) =>
diff --git a/src/urweb.grm b/src/urweb.grm
index 647c311e..a6af8aa3 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1738,6 +1738,15 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In
in
(EVar (["Basis"], "sql_count", Infer), loc)
end)
+ | COUNT LPAREN sqlexp RPAREN (let
+ val loc = s (COUNTleft, RPARENright)
+
+ val e = (EVar (["Basis"], "sql_count_col", Infer), loc)
+ val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
+ e), loc)
+ in
+ (EApp (e, sqlexp), loc)
+ end)
| sqlagg LPAREN sqlexp RPAREN (let
val loc = s (sqlaggleft, RPARENright)
diff --git a/tests/agg.ur b/tests/agg.ur
index 7e091060..55e22c28 100644
--- a/tests/agg.ur
+++ b/tests/agg.ur
@@ -1,22 +1,13 @@
table t1 : {A : int, B : string, C : float}
-table t2 : {A : float, D : int}
+table t2 : {A : float, D : int, E : option string}
val q1 = (SELECT COUNT( * ) AS X FROM t1)
val q2 = (SELECT AVG(t1.A) AS X FROM t1)
val q3 = (SELECT SUM(t1.C) AS X FROM t1)
val q4 = (SELECT MIN(t1.B) AS X, MAX(t1.A) AS Y FROM t1)
-
-(*val q5 = (SELECT t1.A FROM t1 GROUP BY t1.B)*)
val q5 = (SELECT SUM(t1.A) AS X FROM t1 GROUP BY t1.B)
+val q6 = (SELECT COUNT(t2.E) AS N FROM t2 GROUP BY t2.D)
-
-datatype list a = Nil | Cons of a * list a
-
-val r1 : transaction (list string) =
- query q4
- (fn fs acc => return (Cons (fs.X, acc)))
- Nil
-
-val main : unit -> transaction page = fn () =>
- n <- r1;
- return <html><body>Nothing to see here!</body></html>
+fun main () : transaction page =
+ xml <- queryX q6 (fn r => <xml>{[r.N]};</xml>);
+ return <xml><body>{xml}</body></xml>
diff --git a/tests/agg.urp b/tests/agg.urp
new file mode 100644
index 00000000..61e6764e
--- /dev/null
+++ b/tests/agg.urp
@@ -0,0 +1,4 @@
+database /tmp/test
+sql agg.sql
+
+agg