Start of Decision

10 files changed, 172 insertions, 17 deletions

diff --git a/demo/more/bid.ur b/demo/more/bid.ur
index 171dbedb..50645f38 100644
--- a/demo/more/bid.ur
+++ b/demo/more/bid.ur
@@ -1,3 +1,5 @@
+con fields userId paperId = [User = userId, Paper = paperId]
+
 functor Make(M : Conference.INPUT) = struct
     open M
 
diff --git a/demo/more/bid.urs b/demo/more/bid.urs
index f731f9ba..1504c1b7 100644
--- a/demo/more/bid.urs
+++ b/demo/more/bid.urs
@@ -1,3 +1,7 @@
+con fields :: Type -> Type -> {Type}
+
 functor Make (M : Conference.INPUT) : Conference.OUTPUT where con paper = M.paper
                                                         where con userId = M.userId
                                                         where con paperId = M.paperId
+                                                        where con yourPaperTables = [Assignment
+                                                                                     = fields M.userId M.paperId]
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 3c262e15..8f6dff2a 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -45,19 +45,26 @@ open Meta
 functor Make(M : sig
                  con paper :: {(Type * Type)}
                  constraint [Id, Document, Authors] ~ paper
-                 val paper : $(map meta paper)
+                 val paper : $(map Meta.meta paper)
                  val paperFolder : folder paper
 
+                 con paperPrivate :: {Type}
+                 constraint [Id, Document, Authors] ~ paperPrivate
+                 constraint paper ~ paperPrivate
+                 val paperPrivate : $(map Meta.private paperPrivate)
+                 val paperPrivateFolder : folder paperPrivate
+
                  con review :: {(Type * Type)}
                  constraint [Paper, User] ~ review
-                 val review : $(map meta review)
+                 val review : $(map Meta.meta review)
                  val reviewFolder : folder review
 
                  val submissionDeadline : time
-                 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper) -> xml ([Body] ++ ctx) [] []
+                 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper ++ paperPrivate)
+                                                                          -> xml ([Body] ++ ctx) [] []
 
-                 functor Make (M : INPUT where con paper = map fst paper)
-                         : OUTPUT where con paper = map fst paper
+                 functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate)
+                         : OUTPUT where con paper = map fst paper ++ paperPrivate
                                   where con userId = M.userId
                                   where con paperId = M.paperId
              end) = struct
@@ -67,7 +74,7 @@ functor Make(M : sig
           CONSTRAINT Nam UNIQUE Nam
     sequence userId
 
-    con paper = [Id = int, Document = blob] ++ map fst M.paper
+    con paper = [Id = int, Document = blob] ++ map fst M.paper ++ M.paperPrivate
     table paper : paper
           PRIMARY KEY Id
     sequence paperId
@@ -254,7 +261,8 @@ functor Make(M : sig
                 else
                     id <- nextval paperId;
                     dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)}
-                                           ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder));
+                                           ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder
+                                           ++ initialize M.paperPrivate M.paperPrivateFolder));
                     List.app (fn uid =>
                                  case uid of
                                      None => error <xml>Impossible empty uid!</xml>
@@ -287,10 +295,12 @@ functor Make(M : sig
             </body></xml>
         end
 
-    and listPapers [tabs] [[Paper] ~ tabs] (q : sql_query ([Paper = [Id = int] ++ map fst M.paper] ++ tabs) []) =
+    and listPapers [tabs] [[Paper] ~ tabs]
+                   (q : sql_query ([Paper = [Id = int] ++ map fst M.paper ++ M.paperPrivate] ++ tabs) []) =
         checkOnPc;
         ps <- queryX q
-                     (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a></li></xml>);
+                     (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a>
+                     </li></xml>);
         return <xml><body>
           <h1>All Papers</h1>
           
@@ -301,7 +311,7 @@ functor Make(M : sig
 
     and all () =
         checkOnPc;
-        listPapers (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper)
+        listPapers (SELECT paper.Id, paper.{{map fst M.paper ++ M.paperPrivate}} FROM paper)
 
     and your () =
         me <- getLogin;
@@ -310,7 +320,10 @@ functor Make(M : sig
                                                   Where = (WHERE TRUE),
                                                   GroupBy = sql_subset_all [_],
                                                   Having = (WHERE TRUE),
-                                                  SelectFields = sql_subset [[Paper = ([Id = _] ++ map fst M.paper, _)]
+                                                  SelectFields = sql_subset [[Paper =
+                                                                              ([Id = _]
+                                                                                   ++ map fst M.paper
+                                                                                   ++ M.paperPrivate, _)]
                                                                                  ++ map (fn ts => ([], ts))
                                                                                             O.yourPaperTables],
                                                   SelectExps = {}},
@@ -412,3 +425,28 @@ functor Make(M : sig
           | Some r => returnBlob r.Paper.Document (blessMime "application/pdf")
 
 end
+
+
+functor Join(M : sig
+                 structure O1 : OUTPUT
+
+                 structure O2 : OUTPUT where con paper = O1.paper
+                                       where con userId = O1.userId
+                                       where con paperId = O1.paperId
+
+                 constraint O1.yourPaperTables ~ O2.yourPaperTables
+             end)
+        = struct
+            open M
+            open O1
+
+            val linksForPc = <xml>{O1.linksForPc}{O2.linksForPc}</xml>
+            val linksForChair = <xml>{O1.linksForChair}{O2.linksForChair}</xml>
+
+            con yourPaperTables = O1.yourPaperTables ++ O2.yourPaperTables
+            constraint [Paper] ~ yourPaperTables
+
+            fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
+                              uid (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
+                O2.joinYourPaper uid (O1.joinYourPaper uid fi)
+        end
diff --git a/demo/more/conference.urp b/demo/more/conference.urp
index 9e0d8eaa..663fd681 100644
--- a/demo/more/conference.urp
+++ b/demo/more/conference.urp
@@ -12,3 +12,4 @@ select
 checkGroup
 expandable
 bid
+decision
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 16e6732f..8ecb1692 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -46,16 +46,23 @@ functor Make(M : sig
                  val paper : $(map Meta.meta paper)
                  val paperFolder : folder paper
 
+                 con paperPrivate :: {Type}
+                 constraint [Id, Document, Authors] ~ paperPrivate
+                 constraint paper ~ paperPrivate
+                 val paperPrivate : $(map Meta.private paperPrivate)
+                 val paperPrivateFolder : folder paperPrivate
+
                  con review :: {(Type * Type)}
                  constraint [Paper, User] ~ review
                  val review : $(map Meta.meta review)
                  val reviewFolder : folder review
 
                  val submissionDeadline : time
-                 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper) -> xml ([Body] ++ ctx) [] []
+                 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper ++ paperPrivate)
+                                                                          -> xml ([Body] ++ ctx) [] []
 
-                 functor Make (M : INPUT where con paper = map fst paper)
-                         : OUTPUT where con paper = map fst paper
+                 functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate)
+                         : OUTPUT where con paper = map fst paper ++ paperPrivate
                                   where con userId = M.userId
                                   where con paperId = M.paperId
              end) : sig
@@ -63,3 +70,16 @@ functor Make(M : sig
     val main : unit -> transaction page
 
 end
+
+functor Join(M : sig
+                 structure O1 : OUTPUT
+
+                 structure O2 : OUTPUT where con paper = O1.paper
+                                       where con userId = O1.userId
+                                       where con paperId = O1.paperId
+
+                 constraint O1.yourPaperTables ~ O2.yourPaperTables
+             end) : OUTPUT where con paper = M.O1.paper
+                           where con userId = M.O1.userId
+                           where con paperId = M.O1.paperId
+                           where con yourPaperTables = M.O1.yourPaperTables ++ M.O2.yourPaperTables
diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur
index 501788a8..55aa1241 100644
--- a/demo/more/conference1.ur
+++ b/demo/more/conference1.ur
@@ -3,14 +3,21 @@ open ConferenceFields
 open Conference.Make(struct
                          val paper = {Title = title,
                                       Abstract = abstract}
+                         val paperPrivate = {Decision = Decision.decision}
                          val review = {Rating = dropdown "Rating" (#"A" :: #"B" :: #"C" :: #"D" :: []),
                                        CommentsForAuthors = commentsForAuthors}
 
                          val submissionDeadline = readError "2009-11-22 23:59:59"
 
-                         fun summarizePaper [ctx] [[Body] ~ ctx] r = cdata r.Title
+                         fun summarizePaper [ctx] [[Body] ~ ctx] r = txt r.Title
 
-                         functor Make (M : Conference.INPUT where con paper = [Title = string, Abstract = string]) = struct
-                             open Bid.Make(M)
+                         functor Make (M : Conference.INPUT where con paper = _) = struct
+                             open Conference.Join(struct
+                                                      structure O1 = Bid.Make(M)
+                                                      structure O2 = Decision.Make(struct
+                                                                                       con paperOther = _
+                                                                                       open M
+                                                                                   end)
+                                                  end)
                          end
                      end)
diff --git a/demo/more/decision.ur b/demo/more/decision.ur
new file mode 100644
index 00000000..986658e8
--- /dev/null
+++ b/demo/more/decision.ur
@@ -0,0 +1,55 @@
+val decision = {Nam = "Decision",
+                Initialize = None,
+                Show = fn bo => cdata (case bo of
+                                           None => "?"
+                                         | Some True => "Accept"
+                                         | Some False => "Reject"),
+                Inject = _}
+
+functor Make(M : sig
+                 con paperOther :: {Type}
+                 constraint [Id, Decision] ~ paperOther
+                 include Conference.INPUT
+                         where con paper = [Decision = option bool] ++ paperOther
+             end) = struct
+    open M
+
+    val linksForChair =
+        let
+            fun makeDecisions () =
+                ps <- queryX (SELECT paper.Id, paper.Decision, paper.{{M.paperOther}}
+                              FROM paper
+                              ORDER BY paper.Id)
+                      (fn r => <xml><tr>
+                        <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
+                        <td><entry>
+                          <hidden{#Paper} value={show r.Paper.Id}/>
+                          <select{#Decision}>
+                            <option selected={r.Paper.Decision = None}>?</option>
+                            <option selected={r.Paper.Decision = Some True}>Accept</option>
+                            <option selected={r.Paper.Decision = Some False}>Reject</option>
+                        </select></entry></td>
+                      </tr></xml>);
+                return <xml><body>
+                  <h1>Make acceptance decisions</h1>
+
+                  <form><subforms{#Papers}>
+                    <table>
+                      <tr> <th>Paper</th> <th>Decision</th> </tr>
+                      {ps}
+                    </table>
+                  </subforms></form>
+                </body></xml>
+        in
+            <xml>
+              <li><a link={makeDecisions ()}>Make acceptance decisions</a></li>
+            </xml>
+        end
+
+    val linksForPc = <xml/>
+
+    con yourPaperTables = []
+    constraint [Paper] ~ yourPaperTables
+    fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
+        uid (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) = fi
+end
diff --git a/demo/more/decision.urs b/demo/more/decision.urs
new file mode 100644
index 00000000..d3ac0d46
--- /dev/null
+++ b/demo/more/decision.urs
@@ -0,0 +1,11 @@
+val decision : Meta.private (option bool)
+
+functor Make (M : sig
+                  con paperOther :: {Type}
+                  constraint [Id, Decision] ~ paperOther
+                  include Conference.INPUT
+                          where con paper = [Decision = option bool] ++ paperOther
+              end) : Conference.OUTPUT where con paper = [Decision = option bool] ++ M.paperOther
+                                       where con userId = M.userId
+                                       where con paperId = M.paperId
+                                       where con yourPaperTables = []
diff --git a/demo/more/meta.ur b/demo/more/meta.ur
index 74b5004f..b8a3d584 100644
--- a/demo/more/meta.ur
+++ b/demo/more/meta.ur
@@ -80,3 +80,12 @@ fun ensql [avail] [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map snd
     map2 [meta] [snd] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1]
          (fn [ts] meta v => @sql_inject meta.Inject (meta.Parse v))
          [_] fl r vs
+
+con private = fn t :: Type =>
+                 {Nam : string,
+                  Initialize : t,
+                  Show : t -> xbody,
+                  Inject : sql_injectable t}
+
+fun initialize [ts] (r : $(map private ts)) (fl : folder ts) =
+    mp [private] [sql_exp [] [] []] (fn [t] r => @sql_inject r.Inject r.Initialize) [_] fl r
diff --git a/demo/more/meta.urs b/demo/more/meta.urs
index 0d3422af..cd3e183a 100644
--- a/demo/more/meta.urs
+++ b/demo/more/meta.urs
@@ -26,3 +26,11 @@ val allPopulatedTr : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -
 
 val ensql : avail ::: {{Type}} -> ts ::: {(Type * Type)} -> $(map meta ts) -> $(map snd ts) -> folder ts
             -> $(map (sql_exp avail [] []) (map fst ts))
+
+con private = fn t :: Type =>
+                 {Nam : string,
+                  Initialize : t,
+                  Show : t -> xbody,
+                  Inject : sql_injectable t}
+
+val initialize : ts ::: {Type} -> $(map private ts) -> folder ts -> $(map (sql_exp [] [] []) ts)