From 8cc7053b00237cd468290cb5f2042898e7a80329 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 14 Sep 2008 15:10:04 -0400 Subject: Crud supports INSERT --- tests/crud.ur | 58 ++++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 48 insertions(+), 10 deletions(-) (limited to 'tests/crud.ur') 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 + Inserted with ID {txt _ id}. + + fun delete (id : int) = () <- dml (DELETE FROM tab WHERE Id = {id}); return @@ -28,11 +50,11 @@ fun confirm (id : int) = return fun main () : transaction page = rows <- queryX (SELECT * FROM tab AS T) - (fn (fs : {T : $([Id = int] ++ M.cols)}) => + (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => {txt _ fs.T.Id} - {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 => {col.Show v} @@ -51,8 +73,8 @@ fun main () : transaction page = - {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 => @@ -61,6 +83,22 @@ fun main () : transaction page = {rows}

ID
{cdata col.Nam}

+ +
+ + + {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)) => +

{cdata col.Nam}: {col.Widget [nm]}

+ {useMore acc} + ) + + [M.cols] M.cols} + + + end -- cgit v1.2.3