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