diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-10-20 11:05:58 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-10-20 11:05:58 -0400 |
| commit | e23f4d764bc93640cb08a7d6ebd7e261fac2cb05 (patch) | |
| tree | d11bc3451bff30a58f66c2d1dbb41852526a308f /demo | |
| parent | 66fa98fe9619afa56b10f1357edb617dc813051c (diff) | |
Registering for Conference1
Diffstat (limited to 'demo')
| -rw-r--r-- | demo/more/conference.ur | 87 | ||||
| -rw-r--r-- | demo/more/conference.urp | 1 | ||||
| -rw-r--r-- | demo/more/conference.urs | 17 | ||||
| -rw-r--r-- | demo/more/conference1.ur | 4 | ||||
| -rw-r--r-- | demo/more/conference1.urp | 5 |
5 files changed, 98 insertions, 16 deletions
diff --git a/demo/more/conference.ur b/demo/more/conference.ur index a028bc41..569059c1 100644 --- a/demo/more/conference.ur +++ b/demo/more/conference.ur @@ -1,11 +1,11 @@ -con reviewMeta = fn (db :: Type, widget :: Type) => - {Show : db -> xbody, - Widget : nm :: Name -> xml form [] [nm = widget], - WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget], - Parse : widget -> db, - Inject : sql_injectable db} - -fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) : reviewMeta (t, string) = +con meta = fn (db :: Type, widget :: Type) => + {Show : db -> xbody, + Widget : nm :: Name -> xml form [] [nm = widget], + WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget], + Parse : widget -> db, + Inject : sql_injectable db} + +fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) : meta (t, string) = {Show = txt, Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>, WidgetPopulated = fn [nm :: Name] n => @@ -24,10 +24,77 @@ val bool = {Show = txt, Inject = _} functor Make(M : sig + con paper :: {(Type * Type)} + constraint [Id, Title] ~ paper + val paper : $(map meta paper) + con review :: {(Type * Type)} - val review : $(map reviewMeta review) + constraint [Paper, User] ~ review + val review : $(map meta review) end) = struct - fun main () = return <xml/> + table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool} + PRIMARY KEY Id, + CONSTRAINT Nam UNIQUE Nam + sequence userId + + con paper = [Id = int, Title = string] ++ map fst M.paper + table paper : paper + PRIMARY KEY Id + sequence paperId + + con review = [Paper = int, User = int] ++ map fst M.review + table review : review + PRIMARY KEY (Paper, User), + CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id), + CONSTRAINT User FOREIGN KEY User REFERENCES user(Id) + sequence reviewId + + cookie login : {Id : int, Password : string} + + fun checkLogin () = + r <- getCookie login; + case r of + None => return None + | Some r => + oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc + FROM user + WHERE user.Id = {[r.Id]} + AND user.Password = {[r.Password]}) + + fun doRegister r = + n <- oneRowE1 (SELECT COUNT( * ) AS N + FROM user + WHERE user.Nam = {[r.Nam]}); + if n > 0 then + register (Some "Sorry; that username is taken.") + else + id <- nextval userId; + dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc) + VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE)); + setCookie login {Id = id, Password = r.Password}; + main () + + and register msg = return <xml><body> + <h1>Registering a New Account</h1> + + {case msg of + None => <xml/> + | Some msg => <xml><div>{[msg]}</div></xml>} + + <form><table> + <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr> + <tr> <th>Password:</th> <td><password{#Password}/></td> </tr> + <tr> <th><submit action={doRegister}/></th> </tr> + </table></form> + </body></xml> + + and main () = + me <- checkLogin (); + return <xml><body> + {case me of + None => <xml><li><a link={register None}>Register for access</a></li></xml> + | Some {Nam = name, ...} => <xml>Welcome, {[name]}!</xml>} + </body></xml> end diff --git a/demo/more/conference.urp b/demo/more/conference.urp index 399721d4..51a63cb0 100644 --- a/demo/more/conference.urp +++ b/demo/more/conference.urp @@ -1,2 +1,3 @@ +$/option conference diff --git a/demo/more/conference.urs b/demo/more/conference.urs index 696b8b32..aecdf143 100644 --- a/demo/more/conference.urs +++ b/demo/more/conference.urs @@ -1,18 +1,23 @@ -con reviewMeta = fn (db :: Type, widget :: Type) => +con meta = fn (db :: Type, widget :: Type) => {Show : db -> xbody, Widget : nm :: Name -> xml form [] [nm = widget], WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget], Parse : widget -> db, Inject : sql_injectable db} -val int : reviewMeta (int, string) -val float : reviewMeta (float, string) -val string : reviewMeta (string, string) -val bool : reviewMeta (bool, bool) +val int : meta (int, string) +val float : meta (float, string) +val string : meta (string, string) +val bool : meta (bool, bool) functor Make(M : sig + con paper :: {(Type * Type)} + constraint [Id, Title] ~ paper + val paper : $(map meta paper) + con review :: {(Type * Type)} - val review : $(map reviewMeta review) + constraint [Paper, User] ~ review + val review : $(map meta review) end) : sig val main : unit -> transaction page diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur new file mode 100644 index 00000000..8d263a3c --- /dev/null +++ b/demo/more/conference1.ur @@ -0,0 +1,4 @@ +open Conference.Make(struct + val paper = {} + val review = {} + end) diff --git a/demo/more/conference1.urp b/demo/more/conference1.urp new file mode 100644 index 00000000..c78219c4 --- /dev/null +++ b/demo/more/conference1.urp @@ -0,0 +1,5 @@ +library conference +database dbname=conf1 +sql conf1.sql + +conference1 |