diff demo/more/bid.ur @ 1027:be1aec7333a5

Saving paper assignments
author Adam Chlipala <adamc@hcoop.net>
date Mon, 02 Nov 2009 14:11:08 -0500
parents 7facf72aaf0a
children 8b7971e74335
line wrap: on
line diff
--- a/demo/more/bid.ur	Mon Nov 02 11:37:41 2009 -0500
+++ b/demo/more/bid.ur	Mon Nov 02 14:11:08 2009 -0500
@@ -21,26 +21,26 @@
                               FROM paper JOIN bid ON bid.Paper = paper.Id
                                 JOIN user ON bid.User = user.Id
                               ORDER BY paper.Id, bid.Interest, user.Nam)
-                       (fn r (pid, int, acc, ints, papers) =>
-                           if pid = Some r.Paper.Id then
+                       (fn r (paper, int, acc, ints, papers) =>
+                           if (case paper of None => False | Some r' => r'.Id = r.Paper.Id) then
                                if int = r.Bid.Interest then
-                                   return (pid, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
+                                   return (paper, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
                                else
-                                   return (pid, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
+                                   return (paper, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
                                            (int, acc) :: ints, papers)
                            else
-                               return (Some r.Paper.Id, r.Bid.Interest,
+                               return (Some r.Paper, r.Bid.Interest,
                                        (r.User.Id, r.User.Nam) :: [], [],
-                                       case pid of
+                                       case paper of
                                            None => papers
-                                         | Some pid => (pid, (int, acc) :: ints) :: papers))
+                                         | Some r => (r.Id, r -- #Id, (int, acc) :: ints) :: papers))
                        (None, #" ", [], [], []);
                 let
                     val papersL = case tup.1 of
-                                      Some pid => (pid, (tup.2, tup.3) :: tup.4) :: tup.5
-                                    | _ => []
+                                      Some r => (r.Id, r -- #Id, (tup.2, tup.3) :: tup.4) :: tup.5
+                                    | None => []
 
-                    fun makePapers () = List.mapM (fn (pid, ints) =>
+                    fun makePapers () = List.mapM (fn (pid, extra, ints) =>
                                                       ints <- List.mapM (fn (int, users) =>
                                                                             cg <- CheckGroup.create
                                                                                       (List.mp
@@ -50,7 +50,13 @@
                                                                             ex <- Expandable.create
                                                                                       (CheckGroup.render cg);
                                                                             return (int, cg, ex)) ints;
-                                                      return (pid, ints)) papersL
+                                                      return (pid, extra, ints)) papersL
+
+                    fun saveAssignment ls =
+                        dml (DELETE FROM assignment WHERE TRUE);
+                        List.app (fn (pid, uids) =>
+                                     List.app (fn uid => dml (INSERT INTO assignment (Paper, User)
+                                                              VALUES ({[pid]}, {[uid]}))) uids) ls
                 in
                     papers <- source [];
 
@@ -59,9 +65,9 @@
                       <h1>Assign papers</h1>
 
                       <dyn signal={papers <- signal papers;
-                                   return (List.mapX (fn (pid, ints) => <xml>
+                                   return (List.mapX (fn (pid, extra, ints) => <xml>
                                      <hr/>
-                                     Paper #{[pid]}:
+                                     #{[pid]}: {summarizePaper extra}:
                                      <dyn signal={n <- List.foldl (fn (_, cg, _) total =>
                                                                       this <- CheckGroup.selected cg;
                                                                       total <- total;
@@ -72,6 +78,17 @@
                                        {[intOut int]}: {Expandable.render ex}
                                      </xml>) ints}
                                    </xml>) papers)}/>
+
+                        <br/>
+                        <button value="Save" onclick={papers <- get papers;
+                                                      ls <- List.mapM (fn (pid, _, ints) =>
+                                                                          ints <- List.mapM (fn (_, cg, _) =>
+                                                                                                current
+                                                                                                (CheckGroup.selected cg))
+                                                                                            ints;
+                                                                          return (pid, List.foldl List.append [] ints))
+                                                                      papers;
+                                                      rpc (saveAssignment ls)}/>
                     </body></xml>
                 end
         in
@@ -130,6 +147,7 @@
     con yourPaperTables = [Assignment = _]
     constraint [Paper] ~ yourPaperTables
     fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
-        (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
-        sql_inner_join fi (sql_from_table [#Assignment] assignment) (WHERE Paper.Id = Assignment.Paper)
+        (uid : userId) (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
+        sql_inner_join fi (sql_from_table [#Assignment] assignment)
+                       (WHERE Paper.Id = Assignment.Paper AND Assignment.User = {[uid]})
 end