diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-11-06 19:43:48 -0500 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-11-06 19:43:48 -0500 |
commit | 24b68e6d7408f50023272e765687eab777596363 (patch) | |
tree | 36109508292ec57f01529ab31699ed8837d3f0c8 /demo | |
parent | dd4d718ac9f0a9862ebef19beb568bbedcc85848 (diff) |
Tree demo working (and other assorted regressions fixed)
Diffstat (limited to 'demo')
-rw-r--r-- | demo/crud.ur | 8 | ||||
-rw-r--r-- | demo/prose | 4 | ||||
-rw-r--r-- | demo/refFun.ur | 8 | ||||
-rw-r--r-- | demo/sql.ur | 4 | ||||
-rw-r--r-- | demo/tree.ur | 22 | ||||
-rw-r--r-- | demo/tree.urp | 2 | ||||
-rw-r--r-- | demo/treeFun.ur | 2 |
7 files changed, 36 insertions, 14 deletions
diff --git a/demo/crud.ur b/demo/crud.ur index ee6a95f6..a120cb2a 100644 --- a/demo/crud.ur +++ b/demo/crud.ur @@ -102,7 +102,7 @@ functor Make(M : sig [[nm] ~ rest] => fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) {} [M.cols] inputs M.cols - ++ {Id = (SQL {id})})); + ++ {Id = (SQL {[id]})})); ls <- list (); return <xml><body> <p>Inserted with ID {[id]}.</p> @@ -122,7 +122,7 @@ functor Make(M : sig fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) {} [M.cols] inputs M.cols) - tab (WHERE T.Id = {id})); + tab (WHERE T.Id = {[id]})); ls <- list (); return <xml><body> <p>Saved!</p> @@ -131,7 +131,7 @@ functor Make(M : sig </body></xml> and upd (id : int) = - fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); + fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {[id]}); case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of None => return <xml><body>Not found!</body></xml> | Some fs => return <xml><body><form> @@ -150,7 +150,7 @@ functor Make(M : sig </form></body></xml> and delete (id : int) = - dml (DELETE FROM tab WHERE Id = {id}); + dml (DELETE FROM tab WHERE Id = {[id]}); ls <- list (); return <xml><body> <p>The deed is done.</p> @@ -132,6 +132,10 @@ metaform2.urp <p>This example showcases code reuse by applying the same functor as in the last example. The <tt>Metaform2</tt> module mixes pages from the functor with some new pages of its own.</p> +tree.urp + +<p>Here we see how we can abstract over common patterns of SQL queries. In particular, since standard SQL does not help much with queries over trees, we write a function for traversing an SQL tree, building an HTML representation, based on a user-provided function for rendering individual rows.</p> + crud1.urp <p>This example pulls together much of what we have seen so far. It involves a generic "admin interface" builder. That is, we have the <tt>Crud.Make</tt> functor, which takes in a description of a table and outputs a sub-application for viewing and editing that table.</p> diff --git a/demo/refFun.ur b/demo/refFun.ur index d648f31e..e523bac7 100644 --- a/demo/refFun.ur +++ b/demo/refFun.ur @@ -10,19 +10,19 @@ functor Make(M : sig fun new d = id <- nextval s; - dml (INSERT INTO t (Id, Data) VALUES ({id}, {d})); + dml (INSERT INTO t (Id, Data) VALUES ({[id]}, {[d]})); return id fun read r = - o <- oneOrNoRows (SELECT t.Data FROM t WHERE t.Id = {r}); + o <- oneOrNoRows (SELECT t.Data FROM t WHERE t.Id = {[r]}); return (case o of None => error <xml>You already deleted that ref!</xml> | Some r => r.T.Data) fun write r d = - dml (UPDATE t SET Data = {d} WHERE Id = {r}) + dml (UPDATE t SET Data = {[d]} WHERE Id = {[r]}) fun delete r = - dml (DELETE FROM t WHERE Id = {r}) + dml (DELETE FROM t WHERE Id = {[r]}) end diff --git a/demo/sql.ur b/demo/sql.ur index 43a69573..44ff478f 100644 --- a/demo/sql.ur +++ b/demo/sql.ur @@ -27,7 +27,7 @@ fun list () = and add r = dml (INSERT INTO t (A, B, C, D) - VALUES ({readError r.A}, {readError r.B}, {r.C}, {r.D})); + VALUES ({[readError r.A]}, {[readError r.B]}, {[r.C]}, {[r.D]})); xml <- list (); return <xml><body> <p>Row added.</p> @@ -37,7 +37,7 @@ and add r = and delete a = dml (DELETE FROM t - WHERE t.A = {a}); + WHERE t.A = {[a]}); xml <- list (); return <xml><body> <p>Row deleted.</p> diff --git a/demo/tree.ur b/demo/tree.ur index 06a30cf9..27e9aa21 100644 --- a/demo/tree.ur +++ b/demo/tree.ur @@ -1,3 +1,4 @@ +sequence s table t : { Id : int, Parent : option int, Nam : string } open TreeFun.Make(struct @@ -5,11 +6,28 @@ open TreeFun.Make(struct end) fun row r = <xml> - #{[r.Id]}: {[r.Nam]} + #{[r.Id]}: {[r.Nam]} <a link={del r.Id}>[Delete]</a> + + <form> + Add child: <textbox{#Nam}/> <submit action={add (Some r.Id)}/> + </form> </xml> -fun main () = +and main () = xml <- tree row None; return <xml><body> {xml} + + <form> + Add a top-level node: <textbox{#Nam}/> <submit action={add None}/> + </form> </body></xml> + +and add parent r = + id <- nextval s; + dml (INSERT INTO t (Id, Parent, Nam) VALUES ({[id]}, {[parent]}, {[r.Nam]})); + main () + +and del id = + dml (DELETE FROM t WHERE Id = {[id]}); + main () diff --git a/demo/tree.urp b/demo/tree.urp index 2270dd06..880a7ab4 100644 --- a/demo/tree.urp +++ b/demo/tree.urp @@ -1,5 +1,5 @@ debug -database dbname=tree +database dbname=test sql tree.sql treeFun diff --git a/demo/treeFun.ur b/demo/treeFun.ur index 236f354c..15fe60f5 100644 --- a/demo/treeFun.ur +++ b/demo/treeFun.ur @@ -18,7 +18,7 @@ functor Make(M : sig (root : option M.key) = let fun recurse (root : option key) = - queryX' (SELECT * FROM tab WHERE {[eqNullable' (SQL tab.{parent}) root]}) + queryX' (SELECT * FROM tab WHERE {eqNullable' (SQL tab.{parent}) root}) (fn r => children <- recurse (Some r.Tab.id); return <xml> |