diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-11-20 10:41:58 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-11-20 10:41:58 -0500 |
| commit | 3bbe239dcdcb4ef91dd35ccf369160e103d04f56 (patch) | |
| tree | 9985a59e72d487ff1d1818edf6a69cce7b18414d | |
| parent | 09ced0a87d9c57caaf4a832f2547f366fd6e53bd (diff) | |
Update Crud demo to use local functions
| -rw-r--r-- | demo/crud.ur | 109 |
1 files changed, 57 insertions, 52 deletions
diff --git a/demo/crud.ur b/demo/crud.ur index a120cb2a..a3ad59d1 100644 --- a/demo/crud.ur +++ b/demo/crud.ur @@ -110,59 +110,64 @@ functor Make(M : sig {ls} </body></xml> - and save (id : int) (inputs : $(mapT2T sndTT M.cols)) = - dml (update [mapT2T fstTT M.cols] - (foldT2R2 [sndTT] [colMeta] - [fn cols => $(mapT2T (fn t :: (Type * Type) => - sql_exp [T = [Id = int] - ++ mapT2T 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) - tab (WHERE T.Id = {[id]})); - ls <- list (); - return <xml><body> - <p>Saved!</p> - - {ls} - </body></xml> - and upd (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 <xml><body>Not found!</body></xml> - | Some fs => return <xml><body><form> - {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] (v : t.1) (col : colMeta t) - (acc : xml form [] (mapT2T sndTT rest)) => - <xml> - <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> - {useMore acc} - </xml>) - <xml/> - [M.cols] fs.Tab M.cols} - - <submit action={save id}/> - </form></body></xml> - - and delete (id : int) = - dml (DELETE FROM tab WHERE Id = {[id]}); - ls <- list (); - return <xml><body> - <p>The deed is done.</p> - - {ls} - </body></xml> - - and confirm (id : int) = return <xml><body> - <p>Are you sure you want to delete ID #{[id]}?</p> - - <p><a link={delete id}>I was born sure!</a></p> - </body></xml> + let + fun save (inputs : $(mapT2T sndTT M.cols)) = + dml (update [mapT2T fstTT M.cols] + (foldT2R2 [sndTT] [colMeta] + [fn cols => $(mapT2T (fn t :: (Type * Type) => + sql_exp [T = [Id = int] + ++ mapT2T 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) + tab (WHERE T.Id = {[id]})); + ls <- list (); + return <xml><body> + <p>Saved!</p> + + {ls} + </body></xml> + in + 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> + {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] (v : t.1) (col : colMeta t) + (acc : xml form [] (mapT2T sndTT rest)) => + <xml> + <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> + {useMore acc} + </xml>) + <xml/> + [M.cols] fs.Tab M.cols} + + <submit action={save}/> + </form></body></xml> + end + + and confirm (id : int) = + let + fun delete () = + dml (DELETE FROM tab WHERE Id = {[id]}); + ls <- list (); + return <xml><body> + <p>The deed is done.</p> + + {ls} + </body></xml> + in + return <xml><body> + <p>Are you sure you want to delete ID #{[id]}?</p> + + <p><a link={delete ()}>I was born sure!</a></p> + </body></xml> + end and main () = ls <- list (); |