# HG changeset patch # User Adam Chlipala # Date 1257103580 18000 # Node ID 7facf72aaf0abb08160d75ef71ab509154b1fc6c # Parent 93415bcf54c04230775a5560f707a08308effb94 Initial form for paper assignment diff -r 93415bcf54c0 -r 7facf72aaf0a demo/more/bid.ur --- a/demo/more/bid.ur Sun Nov 01 10:31:18 2009 -0500 +++ b/demo/more/bid.ur Sun Nov 01 14:26:20 2009 -0500 @@ -7,6 +7,79 @@ table assignment : {User : userId, Paper : paperId} PRIMARY KEY (User, Paper) + fun intOut ch = + case ch of + #"_" => "Maybe" + | #"-" => "No" + | #"+" => "Yes" + | _ => error Bid: Invalid Interest code + + val linksForChair = + let + fun assignPapers () = + tup <- query (SELECT paper.Id, paper.{{M.paper}}, user.Id, user.Nam, bid.Interest + 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 + if int = r.Bid.Interest then + return (pid, int, (r.User.Id, r.User.Nam) :: acc, ints, papers) + else + return (pid, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [], + (int, acc) :: ints, papers) + else + return (Some r.Paper.Id, r.Bid.Interest, + (r.User.Id, r.User.Nam) :: [], [], + case pid of + None => papers + | Some pid => (pid, (int, acc) :: ints) :: papers)) + (None, #" ", [], [], []); + let + val papersL = case tup.1 of + Some pid => (pid, (tup.2, tup.3) :: tup.4) :: tup.5 + | _ => [] + + fun makePapers () = List.mapM (fn (pid, ints) => + ints <- List.mapM (fn (int, users) => + cg <- CheckGroup.create + (List.mp + (fn (id, nam) => (id, txt nam, + False)) + users); + ex <- Expandable.create + (CheckGroup.render cg); + return (int, cg, ex)) ints; + return (pid, ints)) papersL + in + papers <- source []; + + return +

Assign papers

+ + +

+ Paper #{[pid]}: + + this <- CheckGroup.selected cg; + total <- total; + return (List.length this + total)) (return 0) ints; + return (txt n)}/>
+ + {List.mapX (fn (int, _, ex) => + {[intOut int]}: {Expandable.render ex} + ) ints} + ) papers)}/> + + end + in + +

Assign papers to people

+ + end + val linksForPc = let fun yourBids () = @@ -14,16 +87,15 @@ ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest FROM paper LEFT JOIN bid ON bid.Paper = paper.Id AND bid.User = {[me.Id]}) - (fn r => - - {useMore - {summarizePaper (r.Paper -- #Id)} - - {Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: []) - r.Bid.Interest} - - } - ); + (fn r => + {useMore (summarizePaper (r.Paper -- #Id))} + + + + {useMore (Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: []) + r.Bid.Interest)} + + ); return

Bid on papers

diff -r 93415bcf54c0 -r 7facf72aaf0a demo/more/checkGroup.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/more/checkGroup.ur Sun Nov 01 14:26:20 2009 -0500 @@ -0,0 +1,15 @@ +con t ctx data = list (data * xml ctx [] [] * source bool) + +fun create [ctx] [data] (items : list (data * xml ctx [] [] * bool)) = + List.mapM (fn (d, x, b) => s <- source b; return (d, x, s)) items + +fun render [ctx] [data] [[Body] ~ ctx] (t : t ([Body] ++ ctx) data) = + List.mapX (fn (_, x, s) => {x}
) t + +fun selected [ctx] [data] (t : t ctx data) = + List.foldlM (fn (d, _, s) ls => + s <- signal s; + return (if s then + d :: ls + else + ls)) [] t diff -r 93415bcf54c0 -r 7facf72aaf0a demo/more/checkGroup.urs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/more/checkGroup.urs Sun Nov 01 14:26:20 2009 -0500 @@ -0,0 +1,5 @@ +con t :: {Unit} -> Type -> Type + +val create : ctx ::: {Unit} -> data ::: Type -> list (data * xml ctx [] [] * bool) -> transaction (t ctx data) +val render : ctx ::: {Unit} -> data ::: Type -> [[Body] ~ ctx] => t ([Body] ++ ctx) data -> xml ([Body] ++ ctx) [] [] +val selected : ctx ::: {Unit} -> data ::: Type -> t ctx data -> signal (list data) diff -r 93415bcf54c0 -r 7facf72aaf0a demo/more/conference.ur --- a/demo/more/conference.ur Sun Nov 01 10:31:18 2009 -0500 +++ b/demo/more/conference.ur Sun Nov 01 14:26:20 2009 -0500 @@ -12,12 +12,14 @@ val paperId_inj : sql_injectable_prim paperId val paperId_show : show paperId val paperId_read : read paperId + val paperId_eq : eq paperId table paper : ([Id = paperId, Document = blob] ++ paper) PRIMARY KEY Id val checkLogin : transaction (option {Id : userId, Nam : string, Chair : bool, OnPc : bool}) val getLogin : transaction {Id : userId, Nam : string, Chair : bool, OnPc : bool} val getPcLogin : transaction {Id : userId, Nam : string, Chair : bool} + val checkChair : transaction unit val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $paper -> xml ([Body] ++ ctx) [] [] end @@ -27,6 +29,7 @@ type paperId val linksForPc : xbody + val linksForChair : xbody con yourPaperTables :: {{Type}} constraint [Paper] ~ yourPaperTables @@ -105,12 +108,20 @@ else error You are not on the PC. + val checkChair = + r <- getLogin; + if r.Chair then + return () + else + error You are not a chair. + structure O = M.Make(struct val user = user val paper = paper val checkLogin = checkLogin val getLogin = getLogin val getPcLogin = getPcLogin + val checkChair = checkChair val summarizePaper = @@M.summarizePaper end) @@ -203,7 +214,10 @@

Welcome, {[me.Nam]}!

{if me.Chair then -

Manage users

+ +

Manage users

+ {O.linksForChair} + else } diff -r 93415bcf54c0 -r 7facf72aaf0a demo/more/conference.urp --- a/demo/more/conference.urp Sun Nov 01 10:31:18 2009 -0500 +++ b/demo/more/conference.urp Sun Nov 01 14:26:20 2009 -0500 @@ -9,4 +9,6 @@ conference conferenceFields select +checkGroup +expandable bid diff -r 93415bcf54c0 -r 7facf72aaf0a demo/more/conference.urs --- a/demo/more/conference.urs Sun Nov 01 10:31:18 2009 -0500 +++ b/demo/more/conference.urs Sun Nov 01 14:26:20 2009 -0500 @@ -12,12 +12,14 @@ val paperId_inj : sql_injectable_prim paperId val paperId_show : show paperId val paperId_read : read paperId + val paperId_eq : eq paperId table paper : ([Id = paperId, Document = blob] ++ paper) PRIMARY KEY Id val checkLogin : transaction (option {Id : userId, Nam : string, Chair : bool, OnPc : bool}) val getLogin : transaction {Id : userId, Nam : string, Chair : bool, OnPc : bool} val getPcLogin : transaction {Id : userId, Nam : string, Chair : bool} + val checkChair : transaction unit val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $paper -> xml ([Body] ++ ctx) [] [] end @@ -27,6 +29,7 @@ type paperId val linksForPc : xbody + val linksForChair : xbody con yourPaperTables :: {{Type}} constraint [Paper] ~ yourPaperTables diff -r 93415bcf54c0 -r 7facf72aaf0a demo/more/expandable.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/more/expandable.ur Sun Nov 01 14:26:20 2009 -0500 @@ -0,0 +1,23 @@ +con t ctx = source bool * xml ctx [] [] + +fun create [ctx] (x : xml ctx [] []) = + s <- source False; + return (s, x) + +fun expand [ctx] (t : t ctx) = + set t.1 True + +fun collapse [ctx] (t : t ctx) = + set t.1 False + +fun render [ctx] [[Body] ~ ctx] (t : t ([Body] ++ ctx)) = + +