blob: efd1b9c7bb1d1aec79d0d6471e7e01ce76a2ba5c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
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
val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $([Id = paperId] ++ paperOther)
-> transaction (xml ([Body] ++ ctx) [] [])
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 => st <- status (r.Paper -- #Decision);
return <xml><tr>
<td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
<td>{useMore st}</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>Status</th> <th>Decision</th> </tr>
{ps}
</table>
</subforms>
<submit value="Save" action={saveDecisions}/>
</form>
</body></xml>
and saveDecisions r =
List.app (fn {Paper = pid, Decision = dec} =>
dml (UPDATE paper
SET Decision = {[case dec of
"?" => None
| "Accept" => Some True
| "Reject" => Some False
| _ => error <xml>Invalid decision code</xml>]}
WHERE Id = {[readError pid]})) r.Papers;
makeDecisions ()
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
|