Mercurial > openid

comparison src/ur/openidUser.ur @ 35:a5574ec3991f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Generalize the formatting options a bit.
author Karn Kallio <kkallio@eka>
date Wed, 20 Apr 2011 15:45:27 -0430
parents c0731afcb0c7
children df258dbf4739
comparison
equal deleted inserted replaced
34:c0731afcb0c7 35:a5574ec3991f
4 style google 4 style google
5 style myspace 5 style myspace
6 style yahoo 6 style yahoo
7 7
8 datatype choose_result a = Success of a | Failure of string 8 datatype choose_result a = Success of a | Failure of string
9
10 signature CTLDISPLAY = sig
11 val formatUser : xbody -> xbody
12 val formatLogout : url -> xbody
13 val formatSignup : url -> xbody
14 val formatLogon : ({User : string} -> transaction page) -> xbody
15 end
16
17 structure DefaultDisplay : CTLDISPLAY = struct
18 fun formatUser user =
19 <xml>You are logged in as {user}</xml>
20
21 fun formatLogout url =
22 <xml><a href={url}>Log Out</a></xml>
23
24 fun formatSignup url =
25 <xml><a href={url}>Sign Up</a></xml>
26
27 fun formatLogon handler =
28 <xml>
29 <form><textbox{#User}/><submit value="Log In" action={handler}/></form>
30 </xml>
31 end
32
9 33
10 functor Make(M: sig 34 functor Make(M: sig
11 con cols :: {Type} 35 con cols :: {Type}
12 constraint [Id] ~ cols 36 constraint [Id] ~ cols
13 val folder : folder cols 37 val folder : folder cols
27 val association : Openid.association_mode 51 val association : Openid.association_mode
28 val realm : option string 52 val realm : option string
29 val formClass : css_class 53 val formClass : css_class
30 val fakeId : option string 54 val fakeId : option string
31 55
32 val ctlDisplay : {User : {Status : xbody, Other : xbody}, 56 structure CtlDisplay : CTLDISPLAY
33 Guest : {Status : xbody, Other : xbody}}
34 end) = struct 57 end) = struct
35 58
36 type user = string 59 type user = string
37 val eq_user = _ 60 val eq_user = _
38 val read_user = _ 61 val read_user = _
296 </xml> 319 </xml>
297 end 320 end
298 in 321 in
299 cur <- current; 322 cur <- current;
300 here <- currentUrl; 323 here <- currentUrl;
324
301 case cur of 325 case cur of
302 Some cur => return {Status = <xml>{M.ctlDisplay.User.Status}{[cur]}</xml>, 326 Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>),
303 Other = <xml><a link={logout ()}>{M.ctlDisplay.User.Other}</a></xml>} 327 Other = {Url = (url (logout ())),
304 | None => return {Status = <xml>{M.ctlDisplay.Guest.Status}<form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form></xml>, 328 Xml = (M.CtlDisplay.formatLogout (url (logout ())))}}
305 Other = <xml><a link={signup (show here)}>{M.ctlDisplay.Guest.Other}</a></xml>} 329 | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))),
330 Other = {Url = (url (signup (show here))),
331 Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}}
306 end 332 end
307 333
308 task periodic 60 = fn () => dml (DELETE FROM session 334 task periodic 60 = fn () => dml (DELETE FROM session
309 WHERE Expires < CURRENT_TIMESTAMP) 335 WHERE Expires < CURRENT_TIMESTAMP)
310 336