diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-10-16 14:52:50 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-10-16 14:52:50 -0400 |
commit | 5a71851c8495e85a43227db438b15a3060d724d9 (patch) | |
tree | ab0690fed40107d83f9a1d07ba3e406eb9f88b9d /tests/crud.ur | |
parent | 0abf429653cf148874a7e4dbf0918e77126b87d2 (diff) |
Fix problem with sig/struct indenting
Diffstat (limited to 'tests/crud.ur')
-rw-r--r-- | tests/crud.ur | 244 |
1 files changed, 122 insertions, 122 deletions
diff --git a/tests/crud.ur b/tests/crud.ur index 226d16d6..81c34472 100644 --- a/tests/crud.ur +++ b/tests/crud.ur @@ -31,133 +31,133 @@ fun bool name = {Nam = name, Inject = _} functor Make(M : sig -con cols :: {(Type * Type)} -constraint [Id] ~ cols -val tab : sql_table ([Id = int] ++ mapT2T fstTT cols) + con cols :: {(Type * Type)} + constraint [Id] ~ cols + val tab : sql_table ([Id = int] ++ mapT2T fstTT cols) -val title : string + val title : string -val cols : colsMeta cols + val cols : colsMeta cols end) = struct -open constraints M -val tab = M.tab - -sequence seq - -fun create (inputs : $(mapT2T sndTT M.cols)) = - id <- nextval seq; - () <- dml (insert tab - (foldT2R2 [sndTT] [colMeta] - [fn cols => $(mapT2T (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 with nm = sql_inject col.Inject (col.Parse input)) - {} [M.cols] inputs M.cols - with #Id = (SQL {id}))); - return <xml><body> - Inserted with ID {txt _ id}. + open constraints M + val tab = M.tab + + sequence seq + + fun create (inputs : $(mapT2T sndTT M.cols)) = + id <- nextval seq; + () <- dml (insert tab + (foldT2R2 [sndTT] [colMeta] + [fn cols => $(mapT2T (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 with nm = sql_inject col.Inject (col.Parse input)) + {} [M.cols] inputs M.cols + with #Id = (SQL {id}))); + return <xml><body> + Inserted with ID {txt _ id}. + </body></xml> + + fun 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 with nm = + sql_inject col.Inject (col.Parse input)) + {} [M.cols] inputs M.cols) + tab (WHERE T.Id = {id})); + return <xml><body> + Saved! + </body></xml> + + 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 <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> + + fun delete (id : int) = + () <- dml (DELETE FROM tab WHERE Id = {id}); + return <xml><body> + The deed is done. + </body></xml> + + fun confirm (id : int) = return <xml><body> + <p>Are you sure you want to delete ID #{txt _ id}?</p> + + <p><a link={delete id}>I was born sure!</a></p> </body></xml> -fun 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 with nm = - sql_inject col.Inject (col.Parse input)) - {} [M.cols] inputs M.cols) - tab (WHERE T.Id = {id})); - return <xml><body> - Saved! - </body></xml> - -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 <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> - -fun delete (id : int) = - () <- dml (DELETE FROM tab WHERE Id = {id}); - return <xml><body> - The deed is done. - </body></xml> - -fun confirm (id : int) = return <xml><body> - <p>Are you sure you want to delete ID #{txt _ id}?</p> - - <p><a link={delete id}>I was born sure!</a></p> -</body></xml> - -fun main () = - rows <- queryX (SELECT * FROM tab AS T) - (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> - <tr> - <td>{txt _ 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} - <td> - <a link={update fs.T.Id}>[Update]</a> - <a link={confirm fs.T.Id}>[Delete]</a> - </td> - </tr> - </xml>); - return <xml><head> - <title>{cdata M.title}</title> - </head><body> - - <h1>{cdata M.title}</h1> - - <table border={1}> - <tr> - <th>ID</th> - {foldT2RX [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} - </tr> - {rows} - </table> - - <br/> - - <form> - {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> - <li> {cdata col.Nam}: {col.Widget [nm]}</li> - {useMore acc} - </xml>) - <xml/> - [M.cols] M.cols} - - <submit action={create}/> - </form> - </body></xml> + fun main () = + rows <- queryX (SELECT * FROM tab AS T) + (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> + <tr> + <td>{txt _ 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} + <td> + <a link={update fs.T.Id}>[Update]</a> + <a link={confirm fs.T.Id}>[Delete]</a> + </td> + </tr> + </xml>); + return <xml><head> + <title>{cdata M.title}</title> + </head><body> + + <h1>{cdata M.title}</h1> + + <table border={1}> + <tr> + <th>ID</th> + {foldT2RX [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} + </tr> + {rows} + </table> + + <br/> + + <form> + {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> + <li> {cdata col.Nam}: {col.Widget [nm]}</li> + {useMore acc} + </xml>) + <xml/> + [M.cols] M.cols} + + <submit action={create}/> + </form> + </body></xml> end |