Mercurial > urweb

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