# HG changeset patch # User Adam Chlipala # Date 1256224537 14400 # Node ID 5a0f6ec208ceca0493d3daa6f11f476dd1e25447 # Parent c6e948ec79e9d8e28b34b9a93fbcbcd24b22225a Checking deadline; sign-in diff -r c6e948ec79e9 -r 5a0f6ec208ce demo/more/conference.ur --- a/demo/more/conference.ur Tue Oct 20 13:08:42 2009 -0400 +++ b/demo/more/conference.ur Thu Oct 22 11:15:37 2009 -0400 @@ -8,6 +8,8 @@ con review :: {(Type * Type)} constraint [Paper, User] ~ review val review : $(map meta review) + + val submissionDeadline : time end) = struct table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool} @@ -81,11 +83,36 @@ - and main () = + and signin r = + ro <- oneOrNoRowsE1 (SELECT user.Id AS N + FROM user + WHERE user.Nam = {[r.Nam]} + AND user.Password = {[r.Password]}); + (case ro of + None => return () + | Some id => setCookie login {Id = id, Password = r.Password}); + m <- main' (); + return + {case ro of + None =>
Invalid username or password.
 + | _ => } + + {m} + + + and main' () = me <- checkLogin; - return + now <- now; + return
    {case me of - None =>
  • Register for access
    •  + None => +
  • Register for access
    • +
  • Log in:
    + + + +
    Username:
    Password:
    • +     | Some me =>
    Welcome, {[me.Nam]}!
    @@ -93,7 +120,16 @@
  • Manage users
    •  else } + + {if now < M.submissionDeadline then +
  • Submit
    •  + else + } } -     +
+ + and main () = + m <- main' (); + return {m} end diff -r c6e948ec79e9 -r 5a0f6ec208ce demo/more/conference.urs --- a/demo/more/conference.urs Tue Oct 20 13:08:42 2009 -0400 +++ b/demo/more/conference.urs Thu Oct 22 11:15:37 2009 -0400 @@ -6,6 +6,8 @@ con review :: {(Type * Type)} constraint [Paper, User] ~ review val review : $(map Meta.meta review) + + val submissionDeadline : time end) : sig val main : unit -> transaction page diff -r c6e948ec79e9 -r 5a0f6ec208ce demo/more/conference1.ur --- a/demo/more/conference1.ur Tue Oct 20 13:08:42 2009 -0400 +++ b/demo/more/conference1.ur Thu Oct 22 11:15:37 2009 -0400 @@ -1,4 +1,6 @@ open Conference.Make(struct val paper = {} val review = {} + + val submissionDeadline = readError "2009-10-22 23:59:59" end) diff -r c6e948ec79e9 -r 5a0f6ec208ce include/urweb.h --- a/include/urweb.h Tue Oct 20 13:08:42 2009 -0400 +++ b/include/urweb.h Thu Oct 22 11:15:37 2009 -0400 @@ -202,6 +202,8 @@ __attribute__((noreturn)) void uw_return_blob(uw_context, uw_Basis_blob, uw_Basis_string mimeType); +uw_Basis_time uw_Basis_now(uw_context); + void uw_register_transactional(uw_context, void *data, uw_callback commit, uw_callback rollback, uw_callback free); void uw_check_heap(uw_context, size_t extra); diff -r c6e948ec79e9 -r 5a0f6ec208ce lib/ur/basis.urs --- a/lib/ur/basis.urs Tue Oct 20 13:08:42 2009 -0400 +++ b/lib/ur/basis.urs Thu Oct 22 11:15:37 2009 -0400 @@ -111,6 +111,11 @@ val current : t ::: Type -> signal t -> transaction t +(** * Time *) + +val now : transaction time + + (** HTTP operations *) val requestHeader : string -> transaction (option string) diff -r c6e948ec79e9 -r 5a0f6ec208ce lib/ur/top.ur --- a/lib/ur/top.ur Tue Oct 20 13:08:42 2009 -0400 +++ b/lib/ur/top.ur Thu Oct 22 11:15:37 2009 -0400 @@ -246,6 +246,11 @@ (fn fs _ => return (Some fs.nm)) None +fun oneOrNoRowsE1 [tab ::: Name] [nm ::: Name] [t ::: Type] [[tab] ~ [nm]] (q : sql_query [tab = []] [nm = t]) = + 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; diff -r c6e948ec79e9 -r 5a0f6ec208ce lib/ur/top.urs --- a/lib/ur/top.urs Tue Oct 20 13:08:42 2009 -0400 +++ b/lib/ur/top.urs Thu Oct 22 11:15:37 2009 -0400 @@ -151,6 +151,11 @@ -> sql_query [nm = fs] [] -> transaction (option $fs) +val oneOrNoRowsE1 : tab ::: Name -> nm ::: Name -> t ::: Type + -> [[tab] ~ [nm]] => + sql_query [tab = []] [nm = t] + -> transaction (option t) + val oneRow : tables ::: {{Type}} -> exps ::: {Type} -> [tables ~ exps] => sql_query tables exps diff -r c6e948ec79e9 -r 5a0f6ec208ce src/c/urweb.c --- a/src/c/urweb.c Tue Oct 20 13:08:42 2009 -0400 +++ b/src/c/urweb.c Thu Oct 22 11:15:37 2009 -0400 @@ -2907,3 +2907,7 @@ return r; } + +uw_Basis_time uw_Basis_now(uw_context ctx) { + return time(NULL); +}