Mercurial > openid
changeset 35:a5574ec3991f
Generalize the formatting options a bit.
author | Karn Kallio <kkallio@eka> |
---|---|
date | Wed, 20 Apr 2011 15:45:27 -0430 |
parents | c0731afcb0c7 |
children | df258dbf4739 |
files | src/ur/openidUser.ur src/ur/openidUser.urs |
diffstat | 2 files changed, 59 insertions(+), 12 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ur/openidUser.ur Mon Apr 18 01:49:24 2011 -0430 +++ b/src/ur/openidUser.ur Wed Apr 20 15:45:27 2011 -0430 @@ -7,6 +7,30 @@ datatype choose_result a = Success of a | Failure of string +signature CTLDISPLAY = sig + val formatUser : xbody -> xbody + val formatLogout : url -> xbody + val formatSignup : url -> xbody + val formatLogon : ({User : string} -> transaction page) -> xbody +end + +structure DefaultDisplay : CTLDISPLAY = struct + fun formatUser user = + <xml>You are logged in as {user}</xml> + + fun formatLogout url = + <xml><a href={url}>Log Out</a></xml> + + fun formatSignup url = + <xml><a href={url}>Sign Up</a></xml> + + fun formatLogon handler = + <xml> + <form><textbox{#User}/><submit value="Log In" action={handler}/></form> + </xml> +end + + functor Make(M: sig con cols :: {Type} constraint [Id] ~ cols @@ -29,8 +53,7 @@ val formClass : css_class val fakeId : option string - val ctlDisplay : {User : {Status : xbody, Other : xbody}, - Guest : {Status : xbody, Other : xbody}} + structure CtlDisplay : CTLDISPLAY end) = struct type user = string @@ -298,11 +321,14 @@ in cur <- current; here <- currentUrl; + case cur of - Some cur => return {Status = <xml>{M.ctlDisplay.User.Status}{[cur]}</xml>, - Other = <xml><a link={logout ()}>{M.ctlDisplay.User.Other}</a></xml>} - | None => return {Status = <xml>{M.ctlDisplay.Guest.Status}<form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form></xml>, - Other = <xml><a link={signup (show here)}>{M.ctlDisplay.Guest.Other}</a></xml>} + Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>), + Other = {Url = (url (logout ())), + Xml = (M.CtlDisplay.formatLogout (url (logout ())))}} + | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))), + Other = {Url = (url (signup (show here))), + Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}} end task periodic 60 = fn () => dml (DELETE FROM session
--- a/src/ur/openidUser.urs Mon Apr 18 01:49:24 2011 -0430 +++ b/src/ur/openidUser.urs Wed Apr 20 15:45:27 2011 -0430 @@ -9,6 +9,26 @@ datatype choose_result a = Success of a | Failure of string +(* Formatting options for the gui elements and controls. *) +signature CTLDISPLAY = sig + + val formatUser : xbody -> xbody + (* Format the display of the logged on user *) + + val formatLogout : url -> xbody + (* Format the logout link *) + + val formatSignup : url -> xbody + (* Format the signup link *) + + val formatLogon : ({User : string} -> transaction page) -> xbody + (* Format the login form *) +end + +(* Some reasonable default gui control formats for programmers in a hurry. *) +structure DefaultDisplay : CTLDISPLAY + + (* Instantiate this functor to create your customized authentication scheme. *) functor Make(M: sig con cols :: {Type} @@ -66,10 +86,9 @@ (* If set, this string is always accepted as a verified * identifier, which can be useful during development (say, * when you're off-network). *) - - val ctlDisplay : {User : {Status : xbody, Other : xbody}, - Guest : {Status : xbody, Other : xbody}} - (* These help formatting the user status controls *) + + structure CtlDisplay : CTLDISPLAY + (* Tells how to format the GUI elements. *) end) : sig type user @@ -86,14 +105,16 @@ val current : transaction (option user) (* Figure out which, if any, user is logged in on this connection. *) + val main : (string -> xbody -> transaction page) -> transaction {Status : xbody, - Other : xbody} + Other : {Url : url, Xml : xbody}} + (* Pass in your generic page template; get out the HTML snippet for user * management, suitable for, e.g., inclusion in your standard page * header. The output gives a "status" chunk, which will either be a login * form or a message about which user is logged in; and an "other" chunk, * which will be a log out or sign up link. *) - + end (* Functor outputs will contain buttons specialized to particular well-known