Saving paper assignments

3 files changed, 38 insertions, 18 deletions

diff --git a/demo/more/bid.ur b/demo/more/bid.ur
index 931fc9c0..98a48fc4 100644
--- a/demo/more/bid.ur
+++ b/demo/more/bid.ur
@@ -21,26 +21,26 @@ functor Make(M : Conference.INPUT) = struct
                               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 @@ functor Make(M : Conference.INPUT) = struct
                                                                             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 @@ functor Make(M : Conference.INPUT) = struct
                       <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 @@ functor Make(M : Conference.INPUT) = struct
                                        {[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 @@ functor Make(M : Conference.INPUT) = struct
     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
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 7b3d3d71..7de3fc51 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -35,7 +35,8 @@ signature OUTPUT = sig
     constraint [Paper] ~ yourPaperTables
     val joinYourPaper : tabs ::: {{Type}} -> paper ::: {Type}
         -> [[Paper] ~ tabs] => [[Paper] ~ yourPaperTables] => [tabs ~ yourPaperTables] => [[Id] ~ paper] =>
-        sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
+        userId
+        -> sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
         -> sql_from_items (yourPaperTables ++ [Paper = [Id = paperId] ++ paper] ++ tabs)
 end
 
@@ -305,7 +306,7 @@ functor Make(M : sig
     and your () =
         me <- getLogin;
         listPapers (sql_query {Rows = sql_query1 {Distinct = False,
-                                                  From = O.joinYourPaper (sql_from_table [#Paper] paper),
+                                                  From = O.joinYourPaper me.Id (sql_from_table [#Paper] paper),
                                                   Where = (WHERE TRUE),
                                                   GroupBy = sql_subset_all [_],
                                                   Having = (WHERE TRUE),
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 2f24bac8..16e6732f 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -35,7 +35,8 @@ signature OUTPUT = sig
     constraint [Paper] ~ yourPaperTables
     val joinYourPaper : tabs ::: {{Type}} -> paper ::: {Type}
         -> [[Paper] ~ tabs] => [[Paper] ~ yourPaperTables] => [tabs ~ yourPaperTables] => [[Id] ~ paper] =>
-        sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
+        userId (* Current user *)
+        -> sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
         -> sql_from_items (yourPaperTables ++ [Paper = [Id = paperId] ++ paper] ++ tabs)
 end