Mercurial > urweb

comparison demo/more/conference.ur @ 1004:a87495bcaeec

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start of user management
author Adam Chlipala <adamc@hcoop.net>
date Tue, 20 Oct 2009 12:48:53 -0400
parents 61c30f0742d7
children 5a0f6ec208ce
comparison
equal deleted inserted replaced
1003:61c30f0742d7 1004:a87495bcaeec
1 con meta = fn (db :: Type, widget :: Type) => 1 open Meta
2 {Show : db -> xbody,
3 Widget : nm :: Name -> xml form [] [nm = widget],
4 WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
5 Parse : widget -> db,
6 Inject : sql_injectable db}
7
8 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) : meta (t, string) =
9 {Show = txt,
10 Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
11 WidgetPopulated = fn [nm :: Name] n =>
12 <xml><textbox{nm} value={show n}/></xml>,
13 Parse = readError,
14 Inject = _}
15
16 val int = default
17 val float = default
18 val string = default
19 val bool = {Show = txt,
20 Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
21 WidgetPopulated = fn [nm :: Name] b =>
22 <xml><checkbox{nm} checked={b}/></xml>,
23 Parse = fn x => x,
24 Inject = _}
25 2
26 functor Make(M : sig 3 functor Make(M : sig
27 con paper :: {(Type * Type)} 4 con paper :: {(Type * Type)}
28 constraint [Id, Title] ~ paper 5 constraint [Id, Title] ~ paper
29 val paper : $(map meta paper) 6 val paper : $(map meta paper)
50 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id) 27 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
51 sequence reviewId 28 sequence reviewId
52 29
53 cookie login : {Id : int, Password : string} 30 cookie login : {Id : int, Password : string}
54 31
55 fun checkLogin () = 32 val checkLogin =
56 r <- getCookie login; 33 r <- getCookie login;
57 case r of 34 case r of
58 None => return None 35 None => return None
59 | Some r => 36 | Some r =>
60 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc 37 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
61 FROM user 38 FROM user
62 WHERE user.Id = {[r.Id]} 39 WHERE user.Id = {[r.Id]}
63 AND user.Password = {[r.Password]}) 40 AND user.Password = {[r.Password]})
41
42 structure Users = BulkEdit.Make(struct
43 con keyName = #Id
44 val visible = {Nam = string "Name",
45 Chair = bool "Chair?",
46 OnPc = bool "On PC?"}
47
48 val title = "Users"
49 val isAllowed =
50 me <- checkLogin;
51 return (Option.isSome me)
52
53 val t = user
54 end)
55
64 56
65 fun doRegister r = 57 fun doRegister r =
66 n <- oneRowE1 (SELECT COUNT( * ) AS N 58 n <- oneRowE1 (SELECT COUNT( * ) AS N
67 FROM user 59 FROM user
68 WHERE user.Nam = {[r.Nam]}); 60 WHERE user.Nam = {[r.Nam]});
88 <tr> <th><submit action={doRegister}/></th> </tr> 80 <tr> <th><submit action={doRegister}/></th> </tr>
89 </table></form> 81 </table></form>
90 </body></xml> 82 </body></xml>
91 83
92 and main () = 84 and main () =
93 me <- checkLogin (); 85 me <- checkLogin;
94 return <xml><body> 86 return <xml><body>
95 {case me of 87 {case me of
96 None => <xml><li><a link={register None}>Register for access</a></li></xml> 88 None => <xml><li><a link={register None}>Register for access</a></li></xml>
97 | Some {Nam = name, ...} => <xml>Welcome, {[name]}!</xml>} 89 | Some me => <xml>
90 <div>Welcome, {[me.Nam]}!</div>
91
92 {if me.Chair then
93 <xml><li><a link={Users.main ()}>Manage users</a></li></xml>
94 else
95 <xml/>}
96 </xml>}
98 </body></xml> 97 </body></xml>
99 98
100 end 99 end