aboutsummaryrefslogtreecommitdiffhomepage
path: root/demo/crud.ur
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-02-24 15:12:13 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-02-24 15:12:13 -0500
commita609e91b959d905fc10554e97df153c09769ec90 (patch)
tree163895f20f3556dd9ebb32a2deb09842eced212e /demo/crud.ur
parent487f7affa283ac96326a6891c29c0800690b2c5f (diff)
Demos compile again, with manual folders
Diffstat (limited to 'demo/crud.ur')
-rw-r--r--demo/crud.ur88
1 files changed, 45 insertions, 43 deletions
diff --git a/demo/crud.ur b/demo/crud.ur
index b365f69b..a6a65bb3 100644
--- a/demo/crud.ur
+++ b/demo/crud.ur
@@ -33,6 +33,8 @@ fun bool name = {Nam = name,
functor Make(M : sig
con cols :: {(Type * Type)}
constraint [Id] ~ cols
+ val fl : folder cols
+
val tab : sql_table ([Id = int] ++ map fstTT cols)
val title : string
@@ -50,12 +52,12 @@ functor Make(M : sig
(fn (fs : {T : $([Id = int] ++ map fstTT M.cols)}) => <xml>
<tr>
<td>{[fs.T.Id]}</td>
- {foldT2RX2 [fstTT] [colMeta] [tr]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
- [[nm] ~ rest] v col => <xml>
- <td>{col.Show v}</td>
- </xml>)
- [M.cols] (fs.T -- #Id) M.cols}
+ {foldRX2 [fstTT] [colMeta] [tr]
+ (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ [[nm] ~ rest] v col => <xml>
+ <td>{col.Show v}</td>
+ </xml>)
+ [M.cols] M.fl (fs.T -- #Id) M.cols}
<td>
<a link={upd fs.T.Id}>[Update]</a>
<a link={confirm fs.T.Id}>[Delete]</a>
@@ -66,12 +68,12 @@ functor Make(M : sig
<table border={1}>
<tr>
<th>ID</th>
- {foldT2RX [colMeta] [tr]
+ {foldRX [colMeta] [tr]
(fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
[[nm] ~ rest] col => <xml>
<th>{cdata col.Nam}</th>
</xml>)
- [M.cols] M.cols}
+ [M.cols] M.fl M.cols}
</tr>
{rows}
</table>
@@ -79,14 +81,14 @@ functor Make(M : sig
<br/><hr/><br/>
<form>
- {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
- [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml>
- <li> {cdata col.Nam}: {col.Widget [nm]}</li>
- {useMore acc}
- </xml>)
+ {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
+ (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml>
+ <li> {cdata col.Nam}: {col.Widget [nm]}</li>
+ {useMore acc}
+ </xml>)
<xml/>
- [M.cols] M.cols}
+ [M.cols] M.fl M.cols}
<submit action={create}/>
</form>
@@ -95,13 +97,13 @@ functor Make(M : sig
and create (inputs : $(map sndTT M.cols)) =
id <- nextval seq;
dml (insert tab
- (foldT2R2 [sndTT] [colMeta]
- [fn cols => $(map (fn t :: (Type * Type) =>
- sql_exp [] [] [] t.1) cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
- [[nm] ~ rest] =>
- fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
- {} [M.cols] inputs M.cols
+ (foldR2 [sndTT] [colMeta]
+ [fn cols => $(map (fn t :: (Type * Type) =>
+ sql_exp [] [] [] t.1) cols)]
+ (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ [[nm] ~ rest] =>
+ fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
+ {} [M.cols] M.fl inputs M.cols
++ {Id = (SQL {[id]})}));
ls <- list ();
return <xml><body>
@@ -113,17 +115,17 @@ functor Make(M : sig
and upd (id : int) =
let
fun save (inputs : $(map sndTT M.cols)) =
- dml (update [map fstTT M.cols]
- (foldT2R2 [sndTT] [colMeta]
- [fn cols => $(map (fn t :: (Type * Type) =>
- sql_exp [T = [Id = int]
- ++ map fstTT M.cols]
- [] [] t.1) cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
- [[nm] ~ rest] =>
- fn input col acc => acc ++ {nm =
- @sql_inject col.Inject (col.Parse input)})
- {} [M.cols] inputs M.cols)
+ dml (update [map fstTT M.cols] !
+ (foldR2 [sndTT] [colMeta]
+ [fn cols => $(map (fn t :: (Type * Type) =>
+ sql_exp [T = [Id = int]
+ ++ map fstTT M.cols]
+ [] [] t.1) cols)]
+ (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ [[nm] ~ rest] =>
+ fn input col acc => acc ++ {nm =
+ @sql_inject col.Inject (col.Parse input)})
+ {} [M.cols] M.fl inputs M.cols)
tab (WHERE T.Id = {[id]}));
ls <- list ();
return <xml><body>
@@ -136,16 +138,16 @@ functor Make(M : sig
case fso : (Basis.option {Tab : $(map fstTT M.cols)}) of
None => return <xml><body>Not found!</body></xml>
| Some fs => return <xml><body><form>
- {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
- [[nm] ~ rest] (v : t.1) (col : colMeta t)
- (acc : xml form [] (map sndTT rest)) =>
- <xml>
- <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
- {useMore acc}
- </xml>)
- <xml/>
- [M.cols] fs.Tab M.cols}
+ {foldR2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
+ (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ [[nm] ~ rest] (v : t.1) (col : colMeta t)
+ (acc : xml form [] (map sndTT rest)) =>
+ <xml>
+ <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
+ {useMore acc}
+ </xml>)
+ <xml/>
+ [M.cols] M.fl fs.Tab M.cols}
<submit action={save}/>
</form></body></xml>