diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-10-22 11:15:37 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-10-22 11:15:37 -0400 |
| commit | cf42469778104a3079191c6e871954ffb3b5c957 (patch) | |
| tree | d366eb0c432244981b3d0a9eaae15e7b0273125e | |
| parent | 3d97fb2839259bada8b730207d4b9de58659cfeb (diff) | |
Checking deadline; sign-in
| -rw-r--r-- | demo/more/conference.ur | 44 | ||||
| -rw-r--r-- | demo/more/conference.urs | 2 | ||||
| -rw-r--r-- | demo/more/conference1.ur | 2 | ||||
| -rw-r--r-- | include/urweb.h | 2 | ||||
| -rw-r--r-- | lib/ur/basis.urs | 5 | ||||
| -rw-r--r-- | lib/ur/top.ur | 5 | ||||
| -rw-r--r-- | lib/ur/top.urs | 5 | ||||
| -rw-r--r-- | src/c/urweb.c | 4 |
8 files changed, 65 insertions, 4 deletions
diff --git a/demo/more/conference.ur b/demo/more/conference.ur index 0410e0bb..8d06e4cf 100644 --- a/demo/more/conference.ur +++ b/demo/more/conference.ur @@ -8,6 +8,8 @@ functor Make(M : sig 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 @@ functor Make(M : sig </table></form> </body></xml> - and main () = - me <- checkLogin; + 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 <xml><body> + {case ro of + None => <xml><div>Invalid username or password.</div></xml> + | _ => <xml/>} + + {m} + </body></xml> + + and main' () = + me <- checkLogin; + now <- now; + return <xml><ul> {case me of - None => <xml><li><a link={register None}>Register for access</a></li></xml> + None => <xml> + <li><a link={register None}>Register for access</a></li> + <li><b>Log in:</b> <form><table> + <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr> + <tr> <th>Password:</th> <td><password{#Password}/></td> </tr> + <tr> <th><submit value="Log in" action={signin}/></th> </tr> + </table></form></li> + </xml> | Some me => <xml> <div>Welcome, {[me.Nam]}!</div> @@ -93,7 +120,16 @@ functor Make(M : sig <xml><li><a link={Users.main ()}>Manage users</a></li></xml> else <xml/>} + + {if now < M.submissionDeadline then + <xml><li>Submit</li></xml> + else + <xml/>} </xml>} - </body></xml> + </ul></xml> + + and main () = + m <- main' (); + return <xml><body>{m}</body></xml> end diff --git a/demo/more/conference.urs b/demo/more/conference.urs index 7ca042a5..450725f9 100644 --- a/demo/more/conference.urs +++ b/demo/more/conference.urs @@ -6,6 +6,8 @@ functor Make(M : sig 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 --git a/demo/more/conference1.ur b/demo/more/conference1.ur index 8d263a3c..5696e2f1 100644 --- a/demo/more/conference1.ur +++ b/demo/more/conference1.ur @@ -1,4 +1,6 @@ open Conference.Make(struct val paper = {} val review = {} + + val submissionDeadline = readError "2009-10-22 23:59:59" end) diff --git a/include/urweb.h b/include/urweb.h index 926d8523..87350dc5 100644 --- a/include/urweb.h +++ b/include/urweb.h @@ -202,6 +202,8 @@ uw_Basis_int uw_Basis_blobSize(uw_context, uw_Basis_blob); __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 --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 7c3c0969..6536dc3f 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -111,6 +111,11 @@ val signal : t ::: Type -> source t -> signal t val current : t ::: Type -> signal t -> transaction t +(** * Time *) + +val now : transaction time + + (** HTTP operations *) val requestHeader : string -> transaction (option string) diff --git a/lib/ur/top.ur b/lib/ur/top.ur index 6a0f8751..10b3f711 100644 --- a/lib/ur/top.ur +++ b/lib/ur/top.ur @@ -246,6 +246,11 @@ fun oneOrNoRows1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [nm = fs] []) = (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 --git a/lib/ur/top.urs b/lib/ur/top.urs index b6734cd3..80d402b1 100644 --- a/lib/ur/top.urs +++ b/lib/ur/top.urs @@ -151,6 +151,11 @@ val oneOrNoRows1 : nm ::: Name -> fs ::: {Type} -> 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 --git a/src/c/urweb.c b/src/c/urweb.c index d9ac4c5f..139a2507 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -2907,3 +2907,7 @@ uw_Basis_string uw_Basis_mstrcat(uw_context ctx, ...) { return r; } + +uw_Basis_time uw_Basis_now(uw_context ctx) { + return time(NULL); +} |