Mercurial > urweb

annotate demo/more/conference.ur @ 1010:6b0f3853cc81

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
authorship table
author Adam Chlipala <adamc@hcoop.net>
date Thu, 22 Oct 2009 14:05:48 -0400
parents 59097824f19b
children 16f7cb0891b6
rev   line source
adamc@1004 1 open Meta
adamc@1001 2
adamc@1001 3 functor Make(M : sig
adamc@1003 4 con paper :: {(Type * Type)}
adamc@1010 5 constraint [Id, Document, Authors] ~ paper
adamc@1003 6 val paper : $(map meta paper)
adamc@1007 7 val paperFolder : folder paper
adamc@1003 8
adamc@1001 9 con review :: {(Type * Type)}
adamc@1003 10 constraint [Paper, User] ~ review
adamc@1003 11 val review : $(map meta review)
adamc@1006 12
adamc@1006 13 val submissionDeadline : time
adamc@1009 14 val summarizePaper : $(map fst paper) -> xbody
adamc@1001 15 end) = struct
adamc@1001 16
adamc@1003 17 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1003 18 PRIMARY KEY Id,
adamc@1003 19 CONSTRAINT Nam UNIQUE Nam
adamc@1003 20 sequence userId
adamc@1003 21
adamc@1008 22 con paper = [Id = int, Document = blob] ++ map fst M.paper
adamc@1003 23 table paper : paper
adamc@1003 24 PRIMARY KEY Id
adamc@1003 25 sequence paperId
adamc@1003 26
adamc@1010 27 table authorship : {Paper : int, User : int}
adamc@1010 28 PRIMARY KEY (Paper, User),
adamc@1010 29 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1010 30 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1010 31
adamc@1003 32 con review = [Paper = int, User = int] ++ map fst M.review
adamc@1003 33 table review : review
adamc@1003 34 PRIMARY KEY (Paper, User),
adamc@1003 35 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1003 36 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1003 37 sequence reviewId
adamc@1003 38
adamc@1003 39 cookie login : {Id : int, Password : string}
adamc@1003 40
adamc@1004 41 val checkLogin =
adamc@1003 42 r <- getCookie login;
adamc@1003 43 case r of
adamc@1003 44 None => return None
adamc@1003 45 | Some r =>
adamc@1003 46 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
adamc@1003 47 FROM user
adamc@1003 48 WHERE user.Id = {[r.Id]}
adamc@1003 49 AND user.Password = {[r.Password]})
adamc@1003 50
adamc@1010 51 val getLogin =
adamc@1010 52 ro <- checkLogin;
adamc@1010 53 case ro of
adamc@1010 54 None => error <xml>You must be logged in to do that.</xml>
adamc@1010 55 | Some r => return r
adamc@1010 56
adamc@1009 57 fun checkPaper id =
adamc@1010 58 r <- getLogin;
adamc@1010 59 if r.OnPc then
adamc@1009 60 return ()
adamc@1009 61 else
adamc@1010 62 error <xml>You aren't authorized to see that paper.</xml>
adamc@1009 63
adamc@1004 64 structure Users = BulkEdit.Make(struct
adamc@1004 65 con keyName = #Id
adamc@1004 66 val visible = {Nam = string "Name",
adamc@1004 67 Chair = bool "Chair?",
adamc@1004 68 OnPc = bool "On PC?"}
adamc@1004 69
adamc@1004 70 val title = "Users"
adamc@1004 71 val isAllowed =
adamc@1004 72 me <- checkLogin;
adamc@1004 73 return (Option.isSome me)
adamc@1004 74
adamc@1004 75 val t = user
adamc@1004 76 end)
adamc@1004 77
adamc@1010 78 datatype dnat = O | S of source dnat
adamc@1010 79 type dnatS = source dnat
adamc@1010 80
adamc@1010 81 fun inc n =
adamc@1010 82 v <- get n;
adamc@1010 83 case v of
adamc@1010 84 O =>
adamc@1010 85 n' <- source O;
adamc@1010 86 set n (S n')
adamc@1010 87 | S n => inc n
adamc@1010 88
adamc@1010 89 fun dec n =
adamc@1010 90 let
adamc@1010 91 fun dec' last n =
adamc@1010 92 v <- get n;
adamc@1010 93 case v of
adamc@1010 94 O => (case last of
adamc@1010 95 None => return ()
adamc@1010 96 | Some n' => set n' O)
adamc@1010 97 | S n' => dec' (Some n) n'
adamc@1010 98 in
adamc@1010 99 dec' None n
adamc@1010 100 end
adamc@1004 101
adamc@1003 102 fun doRegister r =
adamc@1003 103 n <- oneRowE1 (SELECT COUNT( * ) AS N
adamc@1003 104 FROM user
adamc@1003 105 WHERE user.Nam = {[r.Nam]});
adamc@1003 106 if n > 0 then
adamc@1003 107 register (Some "Sorry; that username is taken.")
adamc@1003 108 else
adamc@1003 109 id <- nextval userId;
adamc@1003 110 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
adamc@1003 111 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
adamc@1003 112 setCookie login {Id = id, Password = r.Password};
adamc@1003 113 main ()
adamc@1003 114
adamc@1003 115 and register msg = return <xml><body>
adamc@1003 116 <h1>Registering a New Account</h1>
adamc@1003 117
adamc@1003 118 {case msg of
adamc@1003 119 None => <xml/>
adamc@1003 120 | Some msg => <xml><div>{[msg]}</div></xml>}
adamc@1003 121
adamc@1003 122 <form><table>
adamc@1003 123 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1003 124 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1003 125 <tr> <th><submit action={doRegister}/></th> </tr>
adamc@1003 126 </table></form>
adamc@1003 127 </body></xml>
adamc@1003 128
adamc@1006 129 and signin r =
adamc@1006 130 ro <- oneOrNoRowsE1 (SELECT user.Id AS N
adamc@1006 131 FROM user
adamc@1006 132 WHERE user.Nam = {[r.Nam]}
adamc@1006 133 AND user.Password = {[r.Password]});
adamc@1006 134 (case ro of
adamc@1006 135 None => return ()
adamc@1006 136 | Some id => setCookie login {Id = id, Password = r.Password});
adamc@1006 137 m <- main' ();
adamc@1006 138 return <xml><body>
adamc@1006 139 {case ro of
adamc@1006 140 None => <xml><div>Invalid username or password.</div></xml>
adamc@1006 141 | _ => <xml/>}
adamc@1006 142
adamc@1006 143 {m}
adamc@1006 144 </body></xml>
adamc@1006 145
adamc@1006 146 and main' () =
adamc@1004 147 me <- checkLogin;
adamc@1006 148 now <- now;
adamc@1006 149 return <xml><ul>
adamc@1003 150 {case me of
adamc@1006 151 None => <xml>
adamc@1006 152 <li><a link={register None}>Register for access</a></li>
adamc@1006 153 <li><b>Log in:</b> <form><table>
adamc@1006 154 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1006 155 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1006 156 <tr> <th><submit value="Log in" action={signin}/></th> </tr>
adamc@1006 157 </table></form></li>
adamc@1006 158 </xml>
adamc@1004 159 | Some me => <xml>
adamc@1004 160 <div>Welcome, {[me.Nam]}!</div>
adamc@1004 161
adamc@1004 162 {if me.Chair then
adamc@1004 163 <xml><li><a link={Users.main ()}>Manage users</a></li></xml>
adamc@1004 164 else
adamc@1004 165 <xml/>}
adamc@1006 166
adamc@1009 167 {if me.OnPc then
adamc@1009 168 <xml><li><a link={all ()}>All papers</a></li></xml>
adamc@1009 169 else
adamc@1009 170 <xml/>}
adamc@1009 171
adamc@1006 172 {if now < M.submissionDeadline then
adamc@1007 173 <xml><li><a link={submit ()}>Submit</a></li></xml>
adamc@1006 174 else
adamc@1006 175 <xml/>}
adamc@1004 176 </xml>}
adamc@1006 177 </ul></xml>
adamc@1006 178
adamc@1006 179 and main () =
adamc@1006 180 m <- main' ();
adamc@1006 181 return <xml><body>{m}</body></xml>
adamc@1001 182
adamc@1008 183 and submit () =
adamc@1008 184 let
adamc@1009 185 fun doSubmit r =
adamc@1010 186 me <- getLogin;
adamc@1010 187 coauthors <- List.mapM (fn name => oneOrNoRowsE1 (SELECT user.Id AS N
adamc@1010 188 FROM user
adamc@1010 189 WHERE user.Nam = {[name.Nam]})) r.Authors;
adamc@1010 190 if List.exists Option.isNone coauthors then
adamc@1010 191 error <xml>At least one of those coauthor usernames isn't registered.</xml>
adamc@1010 192 else
adamc@1010 193 id <- nextval paperId;
adamc@1010 194 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)}
adamc@1010 195 ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder));
adamc@1010 196 List.app (fn uid =>
adamc@1010 197 case uid of
adamc@1010 198 None => error <xml>Impossible empty uid!</xml>
adamc@1010 199 | Some uid => dml (INSERT INTO authorship (Paper, User)
adamc@1010 200 VALUES ({[id]}, {[uid]})))
adamc@1010 201 (Some me.Id :: coauthors);
adamc@1010 202 return <xml><body>
adamc@1010 203 Thanks for submitting!
adamc@1010 204 </body></xml>
adamc@1010 205
adamc@1010 206 fun authorBlanks n =
adamc@1010 207 case n of
adamc@1010 208 O => <xml/>
adamc@1010 209 | S n => <xml>
adamc@1010 210 <entry><b>Author:</b> <textbox{#Nam}/><br/></entry>
adamc@1010 211 <dyn signal={authorBlanksS n}/>
adamc@1010 212 </xml>
adamc@1010 213
adamc@1010 214 and authorBlanksS n =
adamc@1010 215 n <- signal n;
adamc@1010 216 return (authorBlanks n)
adamc@1008 217 in
adamc@1010 218 me <- getLogin;
adamc@1010 219 numAuthors <- source O;
adamc@1010 220
adamc@1008 221 return <xml><body>
adamc@1008 222 <h1>Submit a Paper</h1>
adamc@1008 223
adamc@1008 224 <form>
adamc@1010 225 <b>Author:</b> {[me.Nam]}<br/>
adamc@1010 226 <subforms{#Authors}>
adamc@1010 227 <dyn signal={authorBlanksS numAuthors}/>
adamc@1010 228 </subforms>
adamc@1010 229 <button value="Add author" onclick={inc numAuthors}/><br/>
adamc@1010 230 <button value="Remove author" onclick={dec numAuthors}/><br/>
adamc@1010 231 <br/>
adamc@1010 232
adamc@1010 233 {useMore (allWidgets M.paper M.paperFolder)}
adamc@1008 234 <b>Paper:</b> <upload{#Document}/><br/>
adamc@1008 235 <submit value="Submit" action={doSubmit}/>
adamc@1008 236 </form>
adamc@1008 237 </body></xml>
adamc@1008 238 end
adamc@1007 239
adamc@1009 240 and all () =
adamc@1009 241 ps <- queryX (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper)
adamc@1009 242 (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a></li></xml>);
adamc@1009 243 return <xml><body>
adamc@1009 244 <h1>All Papers</h1>
adamc@1009 245
adamc@1009 246 <ul>
adamc@1009 247 {ps}
adamc@1009 248 </ul>
adamc@1009 249 </body></xml>
adamc@1009 250
adamc@1009 251 and one id =
adamc@1009 252 checkPaper id;
adamc@1009 253 ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N
adamc@1009 254 FROM paper
adamc@1009 255 WHERE paper.Id = {[id]});
adamc@1010 256 authors <- queryX (SELECT user.Nam
adamc@1010 257 FROM authorship
adamc@1010 258 JOIN user ON authorship.User = user.Id
adamc@1010 259 WHERE authorship.Paper = {[id]})
adamc@1010 260 (fn r => <xml><li>{[r.User.Nam]}</li></xml>);
adamc@1009 261 case ro of
adamc@1009 262 None => error <xml>Paper not found!</xml>
adamc@1009 263 | Some r => return <xml><body>
adamc@1009 264 <h1>Paper #{[id]}</h1>
adamc@1009 265
adamc@1010 266 <h3>Authors:</h3>
adamc@1010 267 <ul>
adamc@1010 268 {authors}
adamc@1010 269 </ul>
adamc@1010 270
adamc@1009 271 {allContent M.paper r.Paper M.paperFolder}<br/>
adamc@1009 272
adamc@1009 273 {if r.N = 0 then
adamc@1009 274 <xml><div>No paper uploaded yet.</div></xml>
adamc@1009 275 else
adamc@1009 276 <xml><a link={download id}>Download paper</a> ({[r.N]} bytes)</xml>}
adamc@1009 277 </body></xml>
adamc@1009 278
adamc@1009 279 and download id =
adamc@1009 280 checkPaper id;
adamc@1009 281 ro <- oneOrNoRows (SELECT paper.Document
adamc@1009 282 FROM paper
adamc@1009 283 WHERE paper.Id = {[id]});
adamc@1009 284 case ro of
adamc@1009 285 None => error <xml>Paper not found!</xml>
adamc@1009 286 | Some r => returnBlob r.Paper.Document (blessMime "application/pdf")
adamc@1009 287
adamc@1001 288 end