Mercurial > urweb

annotate demo/more/decision.ur @ 1034:a779402841f6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Hooks for measuring how much interesting proving is going on in elaboration
author Adam Chlipala <adamc@hcoop.net>
date Tue, 17 Nov 2009 12:44:14 -0500
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