summaryrefslogtreecommitdiff
path: root/demo
diff options
context:
space:
mode:
Diffstat (limited to 'demo')
-rw-r--r--demo/more/conference.ur9
-rw-r--r--demo/more/conference.urs8
-rw-r--r--demo/more/conference1.ur13
-rw-r--r--demo/more/conferenceFields.ur1
-rw-r--r--demo/more/conferenceFields.urs1
-rw-r--r--demo/more/decision.ur58
-rw-r--r--demo/more/decision.urs3
7 files changed, 66 insertions, 27 deletions
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 8f6dff2a..bf8e364a 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -16,6 +16,11 @@ signature INPUT = sig
table paper : ([Id = paperId, Document = blob] ++ paper)
PRIMARY KEY Id
+ con review :: {Type}
+ constraint [Paper, User] ~ review
+ table review : ([Paper = paperId, User = userId] ++ review)
+ PRIMARY KEY (Paper, User)
+
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}
@@ -63,7 +68,8 @@ functor Make(M : sig
val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper ++ paperPrivate)
-> xml ([Body] ++ ctx) [] []
- functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate)
+ functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate
+ where con review = map fst review)
: OUTPUT where con paper = map fst paper ++ paperPrivate
where con userId = M.userId
where con paperId = M.paperId
@@ -126,6 +132,7 @@ functor Make(M : sig
structure O = M.Make(struct
val user = user
val paper = paper
+ val review = review
val checkLogin = checkLogin
val getLogin = getLogin
val getPcLogin = getPcLogin
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 8ecb1692..de35ad05 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -16,6 +16,11 @@ signature INPUT = sig
table paper : ([Id = paperId, Document = blob] ++ paper)
PRIMARY KEY Id
+ con review :: {Type}
+ constraint [Paper, User] ~ review
+ table review : ([Paper = paperId, User = userId] ++ review)
+ PRIMARY KEY (Paper, User)
+
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}
@@ -61,7 +66,8 @@ functor Make(M : sig
val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper ++ paperPrivate)
-> xml ([Body] ++ ctx) [] []
- functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate)
+ functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate
+ where con review = map fst review)
: OUTPUT where con paper = map fst paper ++ paperPrivate
where con userId = M.userId
where con paperId = M.paperId
diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur
index a365efa8..646ba489 100644
--- a/demo/more/conference1.ur
+++ b/demo/more/conference1.ur
@@ -10,16 +10,23 @@ open Conference.Make(struct
val submissionDeadline = readError "2009-11-22 23:59:59"
fun summarizePaper [ctx] [[Body] ~ ctx] r = txt r.Title
+ functor Make (M : Conference.INPUT where con paper = _
+ where con review = _) = struct
+ open M
+
+ fun status [ctx] [[Body] ~ ctx] r =
+ queryX (SELECT review.Rating
+ FROM review
+ WHERE review.Paper = {[r.Id]})
+ (fn r => <xml>{[r.Review.Rating]}; </xml>)
- 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
- fun status [ctx] [[Body] ~ ctx]
- r = <xml>!</xml>
+ val status = @@status
end)
end)
end
diff --git a/demo/more/conferenceFields.ur b/demo/more/conferenceFields.ur
index d22bd877..18387c96 100644
--- a/demo/more/conferenceFields.ur
+++ b/demo/more/conferenceFields.ur
@@ -22,3 +22,4 @@ fun dropdown name opts = {Nam = name,
Parse = charIn,
Inject = _}
+val dropdown_show = _
diff --git a/demo/more/conferenceFields.urs b/demo/more/conferenceFields.urs
index 04cf902f..3a034770 100644
--- a/demo/more/conferenceFields.urs
+++ b/demo/more/conferenceFields.urs
@@ -4,3 +4,4 @@ val commentsForAuthors : Meta.meta (string, string)
con dropdown :: (Type * Type)
val dropdown : string -> list char -> Meta.meta dropdown
+val dropdown_show : show dropdown.1
diff --git a/demo/more/decision.ur b/demo/more/decision.ur
index b93658ee..efd1b9c7 100644
--- a/demo/more/decision.ur
+++ b/demo/more/decision.ur
@@ -12,37 +12,53 @@ functor Make(M : sig
include Conference.INPUT
where con paper = [Decision = option bool] ++ paperOther
- val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $paperOther -> xml ([Body] ++ ctx) [] []
+ 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 => <xml><tr>
- <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
- <td>{useMore (status (r.Paper -- #Id -- #Decision))}</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>);
+ 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></form>
+ <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>
diff --git a/demo/more/decision.urs b/demo/more/decision.urs
index 9ae585b0..e33403cb 100644
--- a/demo/more/decision.urs
+++ b/demo/more/decision.urs
@@ -6,7 +6,8 @@ functor Make (M : sig
include Conference.INPUT
where con paper = [Decision = option bool] ++ paperOther
- val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $paperOther -> xml ([Body] ++ ctx) [] []
+ val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $([Id = paperId] ++ paperOther)
+ -> transaction (xml ([Body] ++ ctx) [] [])
end) : Conference.OUTPUT where con paper = [Decision = option bool] ++ M.paperOther
where con userId = M.userId
where con paperId = M.paperId
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-20 14:02:31 +0000