Mercurial > urweb

annotate demo/more/decision.ur @ 1228:7dfa67560916

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Using multiple policies to check a written value
author Adam Chlipala <adamc@hcoop.net>
date Sun, 11 Apr 2010 16:46:38 -0400
parents 5d9f47124c4c
children
rev   line source
adamc@1030 1 val decision = {Nam = "Decision",
adamc@1030 2 Initialize = None,
adamc@1030 3 Show = fn bo => cdata (case bo of
adamc@1030 4 None => "?"
adamc@1030 5 | Some True => "Accept"
adamc@1030 6 | Some False => "Reject"),
adamc@1030 7 Inject = _}
adamc@1030 8
adamc@1030 9 functor Make(M : sig
adamc@1030 10 con paperOther :: {Type}
adamc@1030 11 constraint [Id, Decision] ~ paperOther
adamc@1030 12 include Conference.INPUT
adamc@1030 13 where con paper = [Decision = option bool] ++ paperOther
adamc@1031 14
adamc@1032 15 val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $([Id = paperId] ++ paperOther)
adamc@1032 16 -> transaction (xml ([Body] ++ ctx) [] [])
adamc@1030 17 end) = struct
adamc@1030 18 open M
adamc@1030 19
adamc@1030 20 val linksForChair =
adamc@1030 21 let
adamc@1030 22 fun makeDecisions () =
adamc@1032 23 ps <- queryX' (SELECT paper.Id, paper.Decision, paper.{{M.paperOther}}
adamc@1032 24 FROM paper
adamc@1032 25 ORDER BY paper.Id)
adamc@1032 26 (fn r => st <- status (r.Paper -- #Decision);
adamc@1032 27 return <xml><tr>
adamc@1032 28 <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
adamc@1032 29 <td>{useMore st}</td>
adamc@1032 30 <td><entry>
adamc@1032 31 <hidden{#Paper} value={show r.Paper.Id}/>
adamc@1032 32 <select{#Decision}>
adamc@1032 33 <option selected={r.Paper.Decision = None}>?</option>
adamc@1032 34 <option selected={r.Paper.Decision = Some True}>Accept</option>
adamc@1032 35 <option selected={r.Paper.Decision = Some False}>Reject</option>
adamc@1032 36 </select></entry></td>
adamc@1032 37 </tr></xml>);
adamc@1030 38 return <xml><body>
adamc@1030 39 <h1>Make acceptance decisions</h1>
adamc@1030 40
adamc@1032 41 <form>
adamc@1032 42 <subforms{#Papers}>
adamc@1032 43 <table>
adamc@1032 44 <tr> <th>Paper</th> <th>Status</th> <th>Decision</th> </tr>
adamc@1032 45 {ps}
adamc@1032 46 </table>
adamc@1032 47 </subforms>
adamc@1032 48 <submit value="Save" action={saveDecisions}/>
adamc@1032 49 </form>
adamc@1030 50 </body></xml>
adamc@1032 51
adamc@1032 52 and saveDecisions r =
adamc@1032 53 List.app (fn {Paper = pid, Decision = dec} =>
adamc@1032 54 dml (UPDATE paper
adamc@1032 55 SET Decision = {[case dec of
adamc@1032 56 "?" => None
adamc@1032 57 | "Accept" => Some True
adamc@1032 58 | "Reject" => Some False
adamc@1032 59 | _ => error <xml>Invalid decision code</xml>]}
adamc@1032 60 WHERE Id = {[readError pid]})) r.Papers;
adamc@1032 61 makeDecisions ()
adamc@1030 62 in
adamc@1030 63 <xml>
adamc@1030 64 <li><a link={makeDecisions ()}>Make acceptance decisions</a></li>
adamc@1030 65 </xml>
adamc@1030 66 end
adamc@1030 67
adamc@1030 68 val linksForPc = <xml/>
adamc@1030 69
adamc@1030 70 con yourPaperTables = []
adamc@1030 71 constraint [Paper] ~ yourPaperTables
adamc@1030 72 fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
adamc@1030 73 uid (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) = fi
adamc@1030 74 end