diff options
author | Adam Chlipala <adamc@hcoop.net> | 2010-03-16 15:54:35 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2010-03-16 15:54:35 -0400 |
commit | a33b1fdbf6ff02d806ac5c563f9274abc57b6a43 (patch) | |
tree | 9d33fe703a729a1a6e1317fea053f4a3a646cf52 | |
parent | 2bdffddbb847cbd620b8be911a1c1cb229187fc2 (diff) |
COUNT(col)
-rw-r--r-- | lib/ur/basis.urs | 18 | ||||
-rw-r--r-- | src/monoize.sml | 10 | ||||
-rw-r--r-- | src/urweb.grm | 9 | ||||
-rw-r--r-- | tests/agg.ur | 19 | ||||
-rw-r--r-- | tests/agg.urp | 4 |
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 |