# HG changeset patch # User Adam Chlipala # Date 1256051158 14400 # Node ID 61c30f0742d735da33d151455c9e402ed32646b9 # Parent bb3fc575cfe778e810a710ef80a0ecbe2db68a38 Registering for Conference1 diff -r bb3fc575cfe7 -r 61c30f0742d7 demo/more/conference.ur --- a/demo/more/conference.ur Tue Oct 20 10:29:17 2009 -0400 +++ b/demo/more/conference.ur Tue Oct 20 11:05:58 2009 -0400 @@ -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} +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) : reviewMeta (t, string) = +fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) : meta (t, string) = {Show = txt, Widget = fn [nm :: Name] => , WidgetPopulated = fn [nm :: Name] n => @@ -24,10 +24,77 @@ 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 + 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 +

Registering a New Account

+ + {case msg of + None => + | Some msg =>
{[msg]}
} + +
+ + + +
Username:
Password:
+ + + and main () = + me <- checkLogin (); + return + {case me of + None =>
  • Register for access
    •  + | Some {Nam = name, ...} => Welcome, {[name]}!} +     end diff -r bb3fc575cfe7 -r 61c30f0742d7 demo/more/conference.urp --- a/demo/more/conference.urp Tue Oct 20 10:29:17 2009 -0400 +++ b/demo/more/conference.urp Tue Oct 20 11:05:58 2009 -0400 @@ -1,2 +1,3 @@ +$/option conference diff -r bb3fc575cfe7 -r 61c30f0742d7 demo/more/conference.urs --- a/demo/more/conference.urs Tue Oct 20 10:29:17 2009 -0400 +++ b/demo/more/conference.urs Tue Oct 20 11:05:58 2009 -0400 @@ -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 -r bb3fc575cfe7 -r 61c30f0742d7 demo/more/conference1.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/more/conference1.ur Tue Oct 20 11:05:58 2009 -0400 @@ -0,0 +1,4 @@ +open Conference.Make(struct + val paper = {} + val review = {} + end) diff -r bb3fc575cfe7 -r 61c30f0742d7 demo/more/conference1.urp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/more/conference1.urp Tue Oct 20 11:05:58 2009 -0400 @@ -0,0 +1,5 @@ +library conference +database dbname=conf1 +sql conf1.sql + +conference1 diff -r bb3fc575cfe7 -r 61c30f0742d7 lib/ur/top.ur --- a/lib/ur/top.ur Tue Oct 20 10:29:17 2009 -0400 +++ b/lib/ur/top.ur Tue Oct 20 11:05:58 2009 -0400 @@ -236,11 +236,16 @@ fun oneOrNoRows [tables ::: {{Type}}] [exps ::: {Type}] [tables ~ exps] - (q : sql_query tables exps) = + (q : sql_query tables exps) = query q (fn fs _ => return (Some fs)) None +fun oneOrNoRows1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [nm = fs] []) = + query q + (fn fs _ => return (Some fs.nm)) + None + fun oneRow [tables ::: {{Type}}] [exps ::: {Type}] [tables ~ exps] (q : sql_query tables exps) = o <- oneOrNoRows q; @@ -248,6 +253,12 @@ None => error Query returned no rows | Some r => r) +fun oneRowE1 [tab ::: Name] [nm ::: Name] [t ::: Type] [[tab] ~ [nm]] (q : sql_query [tab = []] [nm = t]) = + o <- oneOrNoRows q; + return (case o of + None => error Query returned no rows + | Some r => r.nm) + fun eqNullable [tables ::: {{Type}}] [agg ::: {{Type}}] [exps ::: {Type}] [t ::: Type] (_ : sql_injectable (option t)) (e1 : sql_exp tables agg exps (option t)) diff -r bb3fc575cfe7 -r 61c30f0742d7 lib/ur/top.urs --- a/lib/ur/top.urs Tue Oct 20 10:29:17 2009 -0400 +++ b/lib/ur/top.urs Tue Oct 20 11:05:58 2009 -0400 @@ -147,13 +147,22 @@ $(exps ++ map (fn fields :: {Type} => $fields) tables)) +val oneOrNoRows1 : nm ::: Name -> fs ::: {Type} + -> sql_query [nm = fs] [] + -> transaction (option $fs) + val oneRow : tables ::: {{Type}} -> exps ::: {Type} -> [tables ~ exps] => sql_query tables exps -> transaction $(exps ++ map (fn fields :: {Type} => $fields) tables) - + +val oneRowE1 : tab ::: Name -> nm ::: Name -> t ::: Type + -> [[tab] ~ [nm]] => + sql_query [tab = []] [nm = t] + -> transaction t + val eqNullable : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type -> sql_injectable (option t) -> sql_exp tables agg exps (option t)