con colMeta = fn (db :: Type, widget :: Type) =>
{Nam : string,
Show : db -> xbody,
Widget : nm :: Name -> xml form [] [nm = widget],
WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
Parse : widget -> db,
Inject : sql_injectable db}
con colsMeta = fn cols => $(map colMeta cols)
fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
name : colMeta (t, string) =
{Nam = name,
Show = txt,
Widget = fn [nm :: Name] => ,
WidgetPopulated = fn [nm :: Name] n =>
,
Parse = readError,
Inject = _}
val int = default
val float = default
val string = default
fun bool name = {Nam = name,
Show = txt,
Widget = fn [nm :: Name] => ,
WidgetPopulated = fn [nm :: Name] b =>
,
Parse = fn x => x,
Inject = _}
functor Make(M : sig
con cols :: {(Type * Type)}
constraint [Id] ~ cols
val fl : folder cols
table tab : ([Id = int] ++ map fst cols)
val title : string
val cols : colsMeta cols
end) = struct
val tab = M.tab
sequence seq
fun list () =
rows <- queryX (SELECT * FROM tab AS T)
(fn (fs : {T : $([Id = int] ++ map fst M.cols)}) =>
| {[fs.T.Id]} |
{@mapX2 [fst] [colMeta] [tr]
(fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] v col =>
{col.Show v} |
)
M.fl (fs.T -- #Id) M.cols}
[Update]
[Delete]
|
);
return
| ID |
{@mapX [colMeta] [tr]
(fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] col =>
{cdata col.Nam} |
)
M.fl M.cols}
{rows}
and create (inputs : $(map snd M.cols)) =
id <- nextval seq;
dml (insert tab
(@foldR2 [snd] [colMeta]
[fn cols => $(map (fn t => sql_exp [] [] [] t.1) cols)]
(fn [nm :: Name] [t ::_] [rest ::_] [[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
Inserted with ID {[id]}.
{ls}
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 => sql_exp [T = [Id = int] ++ map fst M.cols] [] [] t.1) cols)]
(fn [nm :: Name] [t ::_] [rest ::_] [[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
Saved!
{ls}
in
fso <- oneOrNoRows (SELECT tab.{{map fst M.cols}} FROM tab WHERE tab.Id = {[id]});
case fso : (Basis.option {Tab : $(map fst M.cols)}) of
None => return Not found!
| Some fs => return
end
and confirm (id : int) =
let
fun delete () =
dml (DELETE FROM tab WHERE Id = {[id]});
ls <- list ();
return
The deed is done.
{ls}
in
return
Are you sure you want to delete ID #{[id]}?
end
and main () =
ls <- list ();
return
{cdata M.title}
{cdata M.title}
{ls}
end