Mercurial > urweb
diff demo/crud.ur @ 632:6c4643880df5
Demos compile again, with manual folders
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 24 Feb 2009 15:12:13 -0500 |
| parents | d64533157f40 |
| children | 24fd1edfcaa3 |
line wrap: on
line diff
--- a/demo/crud.ur Tue Feb 24 14:04:07 2009 -0500 +++ b/demo/crud.ur Tue Feb 24 15:12:13 2009 -0500 @@ -33,6 +33,8 @@ 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 @@ (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 @@ <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 @@ <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 @@ 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 @@ 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 @@ 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>