Mercurial > urweb
diff demo/crud.ur @ 1093:8d3aa6c7cee0
Make summary unification more conservative; infer implicit arguments after applications
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 26 Dec 2009 11:56:40 -0500 |
parents | bb3fc575cfe7 |
children | ad15700272f6 |
line wrap: on
line diff
--- a/demo/crud.ur Fri Dec 25 10:48:02 2009 -0500 +++ b/demo/crud.ur Sat Dec 26 11:56:40 2009 -0500 @@ -50,12 +50,12 @@ (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml> <tr> <td>{[fs.T.Id]}</td> - {foldRX2 [fst] [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} + {@foldRX2 [fst] [colMeta] [tr] + (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] + [[nm] ~ rest] v col => <xml> + <td>{col.Show v}</td> + </xml>) + 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 +66,12 @@ <table border={1}> <tr> <th>ID</th> - {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.fl M.cols} + {@foldRX [colMeta] [tr] + (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] + [[nm] ~ rest] col => <xml> + <th>{cdata col.Nam}</th> + </xml>) + M.fl M.cols} </tr> {rows} </table> @@ -79,14 +79,14 @@ <br/><hr/><br/> <form> - {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] - (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] - [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml> - <li> {cdata col.Nam}: {col.Widget [nm]}</li> - {useMore acc} - </xml>) - <xml/> - [M.cols] M.fl M.cols} + {@foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] + (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] + [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml> + <li> {cdata col.Nam}: {col.Widget [nm]}</li> + {useMore acc} + </xml>) + <xml/> + M.fl M.cols} <submit action={create}/> </form> @@ -95,13 +95,13 @@ and create (inputs : $(map snd M.cols)) = id <- nextval seq; dml (insert tab - (foldR2 [snd] [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 + (@foldR2 [snd] [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.fl inputs M.cols ++ {Id = (SQL {[id]})})); ls <- list (); return <xml><body> @@ -113,17 +113,17 @@ and upd (id : int) = let fun save (inputs : $(map snd M.cols)) = - dml (update [map fst M.cols] ! - (foldR2 [snd] [colMeta] - [fn cols => $(map (fn t :: (Type * Type) => - sql_exp [T = [Id = int] - ++ map fst 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) + dml (update [map fst M.cols] + (@foldR2 [snd] [colMeta] + [fn cols => $(map (fn t :: (Type * Type) => + sql_exp [T = [Id = int] + ++ map fst 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.fl inputs M.cols) tab (WHERE T.Id = {[id]})); ls <- list (); return <xml><body> @@ -136,16 +136,16 @@ case fso : (Basis.option {Tab : $(map fst M.cols)}) of None => return <xml><body>Not found!</body></xml> | Some fs => return <xml><body><form> - {foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] - (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] - [[nm] ~ rest] (v : t.1) (col : colMeta t) - (acc : xml form [] (map snd rest)) => - <xml> - <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> - {useMore acc} - </xml>) - <xml/> - [M.cols] M.fl fs.Tab M.cols} + {@foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] + (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] + [[nm] ~ rest] (v : t.1) (col : colMeta t) + (acc : xml form [] (map snd rest)) => + <xml> + <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> + {useMore acc} + </xml>) + <xml/> + M.fl fs.Tab M.cols} <submit action={save}/> </form></body></xml>