Mercurial > urweb

annotate demo/more/conference.ur @ 1003:61c30f0742d7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Registering for Conference1
author Adam Chlipala <adamc@hcoop.net>
date Tue, 20 Oct 2009 11:05:58 -0400
parents 1d456a06ea4e
children a87495bcaeec
rev   line source
adamc@1003 1 con meta = fn (db :: Type, widget :: Type) =>
adamc@1003 2 {Show : db -> xbody,
adamc@1003 3 Widget : nm :: Name -> xml form [] [nm = widget],
adamc@1003 4 WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
adamc@1003 5 Parse : widget -> db,
adamc@1003 6 Inject : sql_injectable db}
adamc@1001 7
adamc@1003 8 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) : meta (t, string) =
adamc@1001 9 {Show = txt,
adamc@1001 10 Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
adamc@1001 11 WidgetPopulated = fn [nm :: Name] n =>
adamc@1001 12 <xml><textbox{nm} value={show n}/></xml>,
adamc@1001 13 Parse = readError,
adamc@1001 14 Inject = _}
adamc@1001 15
adamc@1001 16 val int = default
adamc@1001 17 val float = default
adamc@1001 18 val string = default
adamc@1001 19 val bool = {Show = txt,
adamc@1001 20 Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
adamc@1001 21 WidgetPopulated = fn [nm :: Name] b =>
adamc@1001 22 <xml><checkbox{nm} checked={b}/></xml>,
adamc@1001 23 Parse = fn x => x,
adamc@1001 24 Inject = _}
adamc@1001 25
adamc@1001 26 functor Make(M : sig
adamc@1003 27 con paper :: {(Type * Type)}
adamc@1003 28 constraint [Id, Title] ~ paper
adamc@1003 29 val paper : $(map meta paper)
adamc@1003 30
adamc@1001 31 con review :: {(Type * Type)}
adamc@1003 32 constraint [Paper, User] ~ review
adamc@1003 33 val review : $(map meta review)
adamc@1001 34 end) = struct
adamc@1001 35
adamc@1003 36 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1003 37 PRIMARY KEY Id,
adamc@1003 38 CONSTRAINT Nam UNIQUE Nam
adamc@1003 39 sequence userId
adamc@1003 40
adamc@1003 41 con paper = [Id = int, Title = string] ++ map fst M.paper
adamc@1003 42 table paper : paper
adamc@1003 43 PRIMARY KEY Id
adamc@1003 44 sequence paperId
adamc@1003 45
adamc@1003 46 con review = [Paper = int, User = int] ++ map fst M.review
adamc@1003 47 table review : review
adamc@1003 48 PRIMARY KEY (Paper, User),
adamc@1003 49 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1003 50 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1003 51 sequence reviewId
adamc@1003 52
adamc@1003 53 cookie login : {Id : int, Password : string}
adamc@1003 54
adamc@1003 55 fun checkLogin () =
adamc@1003 56 r <- getCookie login;
adamc@1003 57 case r of
adamc@1003 58 None => return None
adamc@1003 59 | Some r =>
adamc@1003 60 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
adamc@1003 61 FROM user
adamc@1003 62 WHERE user.Id = {[r.Id]}
adamc@1003 63 AND user.Password = {[r.Password]})
adamc@1003 64
adamc@1003 65 fun doRegister r =
adamc@1003 66 n <- oneRowE1 (SELECT COUNT( * ) AS N
adamc@1003 67 FROM user
adamc@1003 68 WHERE user.Nam = {[r.Nam]});
adamc@1003 69 if n > 0 then
adamc@1003 70 register (Some "Sorry; that username is taken.")
adamc@1003 71 else
adamc@1003 72 id <- nextval userId;
adamc@1003 73 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
adamc@1003 74 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
adamc@1003 75 setCookie login {Id = id, Password = r.Password};
adamc@1003 76 main ()
adamc@1003 77
adamc@1003 78 and register msg = return <xml><body>
adamc@1003 79 <h1>Registering a New Account</h1>
adamc@1003 80
adamc@1003 81 {case msg of
adamc@1003 82 None => <xml/>
adamc@1003 83 | Some msg => <xml><div>{[msg]}</div></xml>}
adamc@1003 84
adamc@1003 85 <form><table>
adamc@1003 86 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1003 87 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1003 88 <tr> <th><submit action={doRegister}/></th> </tr>
adamc@1003 89 </table></form>
adamc@1003 90 </body></xml>
adamc@1003 91
adamc@1003 92 and main () =
adamc@1003 93 me <- checkLogin ();
adamc@1003 94 return <xml><body>
adamc@1003 95 {case me of
adamc@1003 96 None => <xml><li><a link={register None}>Register for access</a></li></xml>
adamc@1003 97 | Some {Nam = name, ...} => <xml>Welcome, {[name]}!</xml>}
adamc@1003 98 </body></xml>
adamc@1001 99
adamc@1001 100 end