diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-09-14 19:03:55 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-09-14 19:03:55 -0400 |
commit | fe35c44cd34ceb2a2f02b27f56bf1607557bb89a (patch) | |
tree | 947cb1a65fa285087e64c14a5c08a9804bc83a7a /tests | |
parent | 7b9035e69d65f463da21a82d5f35deebaf1986ac (diff) |
Crud update form
Diffstat (limited to 'tests')
-rw-r--r-- | tests/crud.ur | 26 | ||||
-rw-r--r-- | tests/crud.urs | 1 | ||||
-rw-r--r-- | tests/crud1.ur | 4 |
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 } |