# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1336932798 14400
# Node ID c1da0e3749b351fc75dba5c699dc075ecebf3ae7
# Parent  9f56676e7c4eb29ccae839ac7e16340b296c353b
Sql.listify

diff -r 9f56676e7c4e -r c1da0e3749b3 lib.urp
--- a/lib.urp	Sun May 06 15:16:27 2012 -0400
+++ b/lib.urp	Sun May 13 14:13:18 2012 -0400
@@ -6,7 +6,7 @@
 eq
 variant
 json
+record
 sql
 parse
 html
-record
diff -r 9f56676e7c4e -r c1da0e3749b3 sql.ur
--- a/sql.ur	Sun May 06 15:16:27 2012 -0400
+++ b/sql.ur	Sun May 13 14:13:18 2012 -0400
@@ -60,3 +60,16 @@
       oneOrNoRows1 (SELECT t.{{otherCols}}
                     FROM t
                     WHERE {@selector [#T] ! kfl kinj (vs --- _)})
+
+fun listify [lead :: Name] [cols ::: {Type}] [rest ::: {{Type}}] [[lead] ~ rest]
+    (fl : folder cols) (eqs : $(map eq cols)) (q : sql_query [] [] ([lead = cols] ++ rest) []) =
+    query q
+    (fn r acc =>
+        return (case acc of
+                    [] => (r.lead, (r -- lead) :: []) :: []
+                  | (key, ls) :: acc' =>
+                    if @Record.equal eqs fl r.lead key then
+                        (key, (r -- lead) :: ls) :: acc'
+                    else
+                        (r.lead, (r -- lead) :: []) :: acc))
+    []
diff -r 9f56676e7c4e -r c1da0e3749b3 sql.urs
--- a/sql.urs	Sun May 06 15:16:27 2012 -0400
+++ b/sql.urs	Sun May 13 14:13:18 2012 -0400
@@ -39,3 +39,9 @@
              -> sql_table (keyCols ++ otherCols) ([Pkey = map (fn _ => ()) keyCols] ++ otherKeys)
              -> $keyCols -> transaction (option $otherCols)
 (* Get the further columns associated with a table key. *)
+
+val listify : lead :: Name -> cols ::: {Type} -> rest ::: {{Type}} -> [[lead] ~ rest]
+              => folder cols -> $(map eq cols)
+              -> sql_query [] [] ([lead = cols] ++ rest) []
+              -> transaction (list ($cols * list $(map (fn ts => $ts) rest)))
+(* Shrink a set of table rows by summarizing into lists, keyed off of a lead table *)