Mercurial > urweb
annotate demo/noisy.ur @ 2081:d4ed20beb93b
Tiny lexer change for SML/NJ compatibility (suggested by Ziv Scully)
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Tue, 25 Nov 2014 08:21:09 -0500 |
parents | e6bc6bbd7a32 |
children |
rev | line source |
---|---|
adamc@651 | 1 datatype list t = Nil | Cons of t * list t |
adamc@651 | 2 |
adamc@651 | 3 table t : { Id : int, A : string } |
adamc@708 | 4 PRIMARY KEY Id |
adamc@651 | 5 |
adamc@651 | 6 fun add id s = |
adamc@651 | 7 dml (INSERT INTO t (Id, A) VALUES ({[id]}, {[s]})) |
adamc@651 | 8 |
adamc@651 | 9 fun del id = |
adamc@651 | 10 dml (DELETE FROM t WHERE t.Id = {[id]}) |
adamc@651 | 11 |
adamc@651 | 12 fun lookup id = |
adamc@651 | 13 ro <- oneOrNoRows (SELECT t.A FROM t WHERE t.Id = {[id]}); |
adamc@651 | 14 case ro of |
adamc@651 | 15 None => return None |
adamc@651 | 16 | Some r => return (Some r.T.A) |
adamc@651 | 17 |
adamc@651 | 18 fun check ls = |
adamc@651 | 19 case ls of |
adamc@651 | 20 Nil => return () |
adamc@651 | 21 | Cons (id, ls') => |
adamc@908 | 22 ao <- rpc (lookup id); |
adamc@651 | 23 alert (case ao of |
adamc@651 | 24 None => "Nada" |
adamc@651 | 25 | Some a => a); |
adamc@651 | 26 check ls' |
adamc@651 | 27 |
adamc@782 | 28 fun main () = |
adamc@651 | 29 idAdd <- source ""; |
adamc@651 | 30 aAdd <- source ""; |
adamc@651 | 31 |
adamc@651 | 32 idDel <- source ""; |
adamc@651 | 33 |
adamc@651 | 34 return <xml><body> |
adam@1784 | 35 <button value="Check values of 1, 2, and 3" onclick={fn _ => check (Cons (1, Cons (2, Cons (3, Nil))))}/><br/> |
adamc@651 | 36 <br/> |
adam@1784 | 37 <button value="Add" onclick={fn _ => id <- get idAdd; a <- get aAdd; rpc (add (readError id) a)}/> |
adamc@651 | 38 <ctextbox source={idAdd}/> |
adamc@651 | 39 <ctextbox source={aAdd}/><br/> |
adamc@651 | 40 <br/> |
adam@1784 | 41 <button value="Delete" onclick={fn _ => id <- get idDel; rpc (del (readError id))}/> |
adamc@651 | 42 <ctextbox source={idDel}/> |
adamc@651 | 43 </body></xml> |