diff lib/basis.lig @ 223:bbe5899a9585

Queries back to working as well as before, after start of refactoring to support grouping
author Adam Chlipala <adamc@hcoop.net>
date Thu, 21 Aug 2008 12:49:29 -0400
parents 79819a6346e2
children cb8a68964ebb
line wrap: on
line diff
--- a/lib/basis.lig	Sat Aug 16 17:50:10 2008 -0400
+++ b/lib/basis.lig	Thu Aug 21 12:49:29 2008 -0400
@@ -14,39 +14,53 @@
 (*** Queries *)
 
 con sql_query :: {{Type}} -> Type
-con sql_exp :: {{Type}} -> Type -> Type
+con sql_exp :: {{Type}} -> {{Type}} -> Type -> Type
 
-val sql_query : tables :: {({Type} * {Type})}
-        -> {From : $(fold (fn nm => fn selected_unselected :: ({Type} * {Type}) => fn acc =>
-                [nm] ~ acc => selected_unselected.1 ~ selected_unselected.2 =>
-                [nm = sql_table (selected_unselected.1 ++ selected_unselected.2)] ++ acc) [] tables),
-            Where : sql_exp (fold (fn nm => fn selected_unselected :: ({Type} * {Type}) => fn acc =>
-                [nm] ~ acc => selected_unselected.1 ~ selected_unselected.2 =>
-                [nm = selected_unselected.1 ++ selected_unselected.2] ++ acc) [] tables) bool}
-        -> sql_query (fold (fn nm => fn selected_unselected :: ({Type} * {Type}) => fn acc => [nm] ~ acc =>
-                [nm = selected_unselected.1] ++ acc) [] tables)
+con sql_subset :: {{Type}} -> {{Type}} -> Type
+val sql_subset : keep_drop :: {({Type} * {Type})}
+        -> sql_subset
+                (fold (fn nm => fn fields :: ({Type} * {Type}) => fn acc =>
+                        [nm] ~ acc => fields.1 ~ fields.2 =>
+                        [nm = fields.1 ++ fields.2] ++ acc) [] keep_drop)
+                (fold (fn nm => fn fields :: ({Type} * {Type}) => fn acc =>
+                        [nm] ~ acc =>
+                        [nm = fields.1] ++ acc) [] keep_drop)
+val sql_subset_all : tables :: {{Type}}
+        -> sql_subset tables tables
+
+val sql_query : tables ::: {{Type}}
+        (*-> grouped ::: {{Type}}*)
+        -> selected ::: {{Type}}
+        -> {From : $(fold (fn nm => fn fields :: {Type} => fn acc =>
+                [nm] ~ acc => [nm = sql_table fields] ++ acc) [] tables),
+            Where : sql_exp tables [] bool,
+            (*GroupBy : sql_subset tables grouped,
+            Having : sql_exp grouped tables bool,*)
+            SelectFields : sql_subset tables selected}
+        -> sql_query selected
 
 val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type
         -> tab :: Name -> field :: Name
-        -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) fieldType
+        -> agg ::: {{Type}}
+        -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) agg fieldType
 
 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}} -> t ::: Type -> t -> sql_injectable t -> sql_exp tables t
+val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> t -> sql_injectable t -> sql_exp tables agg t
 
 con sql_unary :: Type -> Type -> Type
 val sql_not : sql_unary bool bool
-val sql_unary : tables ::: {{Type}} -> arg ::: Type -> res ::: Type
-        -> sql_unary arg res -> sql_exp tables arg -> sql_exp tables res
+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
 
 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}} -> arg1 ::: Type -> arg2 ::: Type -> res ::: Type
-        -> sql_binary arg1 arg2 res -> sql_exp tables arg1 -> sql_exp tables arg2 -> sql_exp tables res
+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
 
 type sql_comparison
 val sql_eq : sql_comparison
@@ -56,8 +70,8 @@
 val sql_gt : sql_comparison
 val sql_ge : sql_comparison
 val sql_comparison : sql_comparison
-        -> tables ::: {{Type}} -> t ::: Type -> sql_exp tables t -> sql_exp tables t
-        -> sql_injectable t -> sql_exp tables bool
+        -> tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> sql_exp tables agg t -> sql_exp tables agg t
+        -> sql_injectable t -> sql_exp tables agg bool
 
 (** XML *)