summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-20 10:41:58 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-20 10:41:58 -0500
commit3bbe239dcdcb4ef91dd35ccf369160e103d04f56 (patch)
tree9985a59e72d487ff1d1818edf6a69cce7b18414d
parent09ced0a87d9c57caaf4a832f2547f366fd6e53bd (diff)
Update Crud demo to use local functions
-rw-r--r--demo/crud.ur109
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 ();