diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/crud.ur | 58 | ||||
| -rw-r--r-- | tests/crud.urs | 16 | ||||
| -rw-r--r-- | tests/crud1.ur | 39 | ||||
| -rw-r--r-- | tests/with.ur | 5 | ||||
| -rw-r--r-- | tests/with.urp | 5 |
5 files changed, 104 insertions, 19 deletions
diff --git a/tests/crud.ur b/tests/crud.ur index 75136226..0a7efeec 100644 --- a/tests/crud.ur +++ b/tests/crud.ur @@ -1,19 +1,41 @@ -con colMeta' = fn t :: Type => {Nam : string, Show : t -> xbody} -con colMeta = fn cols :: {Type} => $(Top.mapTT colMeta' cols) +con colMeta = fn t_formT :: (Type * Type) => { + Nam : string, + Show : t_formT.1 -> xbody, + Widget : nm :: Name -> xml form [] [nm = t_formT.2], + Parse : t_formT.2 -> t_formT.1, + Inject : sql_injectable t_formT.1 +} +con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols) functor Make(M : sig - con cols :: {Type} + con cols :: {(Type * Type)} constraint [Id] ~ cols - val tab : sql_table ([Id = int] ++ cols) + val tab : sql_table ([Id = int] ++ mapT2T fstTT cols) val title : string - val cols : colMeta 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 = [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 + with #Id = (SQL {id}))); + return <html><body> + Inserted with ID {txt _ id}. + </body></html> + fun delete (id : int) = () <- dml (DELETE FROM tab WHERE Id = {id}); return <html><body> @@ -28,11 +50,11 @@ fun confirm (id : int) = return <html><body> fun main () : transaction page = rows <- queryX (SELECT * FROM tab AS T) - (fn (fs : {T : $([Id = int] ++ M.cols)}) => <body> + (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <body> <tr> <td>{txt _ fs.T.Id}</td> - {foldTRX2 [idT] [colMeta'] [tr] - (fn (nm :: Name) (t :: Type) (rest :: {Type}) => + {foldT2RX2 [fstTT] [colMeta] [tr] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => [[nm] ~ rest] => fn v col => <tr> <td>{col.Show v}</td> @@ -51,8 +73,8 @@ fun main () : transaction page = <table border={1}> <tr> <th>ID</th> - {foldTRX [colMeta'] [tr] - (fn (nm :: Name) (t :: Type) (rest :: {Type}) => + {foldT2RX [colMeta] [tr] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => [[nm] ~ rest] => fn col => <tr> <th>{cdata col.Nam}</th> @@ -61,6 +83,22 @@ fun main () : transaction page = </tr> {rows} </table> + + <br/> + + <lform> + {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => + [[nm] ~ rest] => + fn (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <lform> + <li> {cdata col.Nam}: {col.Widget [nm]}</li> + {useMore acc} + </lform>) + <lform></lform> + [M.cols] M.cols} + + <submit action={create}/> + </lform> </body></html> end diff --git a/tests/crud.urs b/tests/crud.urs index 988c5458..d445ed6e 100644 --- a/tests/crud.urs +++ b/tests/crud.urs @@ -1,14 +1,20 @@ -con colMeta' = fn t :: Type => {Nam : string, Show : t -> xbody} -con colMeta = fn cols :: {Type} => $(Top.mapTT colMeta' cols) +con colMeta = fn t_formT :: (Type * Type) => { + Nam : string, + Show : t_formT.1 -> xbody, + Widget : nm :: Name -> xml form [] [nm = t_formT.2], + Parse : t_formT.2 -> t_formT.1, + Inject : sql_injectable t_formT.1 +} +con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols) functor Make(M : sig - con cols :: {Type} + con cols :: {(Type * Type)} constraint [Id] ~ cols - val tab : sql_table ([Id = int] ++ cols) + val tab : sql_table ([Id = int] ++ mapT2T fstTT cols) val title : string - val cols : colMeta cols + val cols : colsMeta cols end) : sig val main : unit -> transaction page end diff --git a/tests/crud1.ur b/tests/crud1.ur index f9d67ed8..fa539dd3 100644 --- a/tests/crud1.ur +++ b/tests/crud1.ur @@ -1,14 +1,45 @@ table t1 : {Id : int, A : int, B : string, C : float, D : bool} open Crud.Make(struct + con cols :: {(Type * Type)} = [ + A = (int, string), + B = (string, string), + C = (float, string), + D = (bool, string) + ] + val tab = t1 val title = "Crud1" val cols = { - A = {Nam = "A", Show = txt _}, - B = {Nam = "B", Show = txt _}, - C = {Nam = "C", Show = txt _}, - D = {Nam = "D", Show = txt _} + A = { + Nam = "A", + Show = txt _, + Widget = fn nm :: Name => <lform><textbox{nm}/></lform>, + Parse = readError _, + Inject = sql_int + }, + B = { + Nam = "B", + Show = txt _, + Widget = fn nm :: Name => <lform><textbox{nm}/></lform>, + Parse = readError _, + Inject = sql_string + }, + C = { + Nam = "C", + Show = txt _, + Widget = fn nm :: Name => <lform><textbox{nm}/></lform>, + Parse = readError _, + Inject = sql_float + }, + D = { + Nam = "D", + Show = txt _, + Widget = fn nm :: Name => <lform><textbox{nm}/></lform>, + Parse = readError _, + Inject = sql_bool + } } end) diff --git a/tests/with.ur b/tests/with.ur new file mode 100644 index 00000000..458153b3 --- /dev/null +++ b/tests/with.ur @@ -0,0 +1,5 @@ +val r = ({A = 1, B = 2} with #C = "Hi") with #D = "Bye" + +fun main () : transaction page = return <html><body> + {cdata r.C}, {cdata r.D} +</body></html> diff --git a/tests/with.urp b/tests/with.urp new file mode 100644 index 00000000..9e1e7fb6 --- /dev/null +++ b/tests/with.urp @@ -0,0 +1,5 @@ +debug +database dbname=test +exe /tmp/webapp + +with |