summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-09-14 19:03:55 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-09-14 19:03:55 -0400
commitfe35c44cd34ceb2a2f02b27f56bf1607557bb89a (patch)
tree947cb1a65fa285087e64c14a5c08a9804bc83a7a /tests
parent7b9035e69d65f463da21a82d5f35deebaf1986ac (diff)
Crud update form
Diffstat (limited to 'tests')
-rw-r--r--tests/crud.ur26
-rw-r--r--tests/crud.urs1
-rw-r--r--tests/crud1.ur4
3 files changed, 30 insertions, 1 deletions
diff --git a/tests/crud.ur b/tests/crud.ur
index 0a7efeec..66a685bf 100644
--- a/tests/crud.ur
+++ b/tests/crud.ur
@@ -2,6 +2,7 @@ con colMeta = fn t_formT :: (Type * Type) => {
Nam : string,
Show : t_formT.1 -> xbody,
Widget : nm :: Name -> xml form [] [nm = t_formT.2],
+ WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2],
Parse : t_formT.2 -> t_formT.1,
Inject : sql_injectable t_formT.1
}
@@ -36,6 +37,29 @@ fun create (inputs : $(mapT2T sndTT M.cols)) =
Inserted with ID {txt _ id}.
</body></html>
+fun save (id : int) _ =
+ return <html><body>
+ Under Construction
+ </body></html>
+
+fun update (id : int) =
+ 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 <html><body>Not found!</body></html>
+ | Some fs => return <html><body><lform>
+ {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
+ (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) =>
+ [[nm] ~ rest] =>
+ fn (v : t.1) (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <lform>
+ <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
+ {useMore acc}
+ </lform>)
+ <lform></lform>
+ [M.cols] fs.Tab M.cols}
+
+ <submit action={save id}/>
+ </lform></body></html>
+
fun delete (id : int) =
() <- dml (DELETE FROM tab WHERE Id = {id});
return <html><body>
@@ -60,7 +84,7 @@ fun main () : transaction page =
<td>{col.Show v}</td>
</tr>)
[M.cols] (fs.T -- #Id) M.cols}
- <td><a link={confirm fs.T.Id}>[Delete]</a></td>
+ <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td>
</tr>
</body>);
return <html><head>
diff --git a/tests/crud.urs b/tests/crud.urs
index d445ed6e..3056392c 100644
--- a/tests/crud.urs
+++ b/tests/crud.urs
@@ -2,6 +2,7 @@ con colMeta = fn t_formT :: (Type * Type) => {
Nam : string,
Show : t_formT.1 -> xbody,
Widget : nm :: Name -> xml form [] [nm = t_formT.2],
+ WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2],
Parse : t_formT.2 -> t_formT.1,
Inject : sql_injectable t_formT.1
}
diff --git a/tests/crud1.ur b/tests/crud1.ur
index fa539dd3..fb2e4854 100644
--- a/tests/crud1.ur
+++ b/tests/crud1.ur
@@ -17,6 +17,7 @@ open Crud.Make(struct
Nam = "A",
Show = txt _,
Widget = fn nm :: Name => <lform><textbox{nm}/></lform>,
+ WidgetPopulated = fn (nm :: Name) n => <lform><textbox{nm} value={show _ n}/></lform>,
Parse = readError _,
Inject = sql_int
},
@@ -24,6 +25,7 @@ open Crud.Make(struct
Nam = "B",
Show = txt _,
Widget = fn nm :: Name => <lform><textbox{nm}/></lform>,
+ WidgetPopulated = fn (nm :: Name) s => <lform><textbox{nm} value={s}/></lform>,
Parse = readError _,
Inject = sql_string
},
@@ -31,6 +33,7 @@ open Crud.Make(struct
Nam = "C",
Show = txt _,
Widget = fn nm :: Name => <lform><textbox{nm}/></lform>,
+ WidgetPopulated = fn (nm :: Name) n => <lform><textbox{nm} value={show _ n}/></lform>,
Parse = readError _,
Inject = sql_float
},
@@ -38,6 +41,7 @@ open Crud.Make(struct
Nam = "D",
Show = txt _,
Widget = fn nm :: Name => <lform><textbox{nm}/></lform>,
+ WidgetPopulated = fn (nm :: Name) b => <lform><textbox{nm} value={show _ b}/></lform>,
Parse = readError _,
Inject = sql_bool
}