con crudField = fn t :: Type =>
{Name : text,
ToHtml : t -> bodyTags,
Input : tab :: NameOpt -> name :: FieldName
-> tagsEnv form (Empty(Type)) [[@@tab.name : t]],
InputInitialized : tab :: NameOpt -> name :: FieldName
-> t -> tagsEnv form (Empty(Type)) [[@@tab.name : t]]}
val intFieldBody = fn name : text =>
{Name = name,
ToHtml = fn n =>
,
Input = fn tab :: NameOpt => fn name :: FieldName
=> ,
InputInitialized = fn tab :: NameOpt => fn name :: FieldName => fn v : integer
=> }
con intField = fn name : text =>
pack integer
with intFieldBody name
as crudField
end
con idField = intField["ID"]
val textFieldBody = fn name : text =>
{Name = name,
ToHtml = fn n => ,
Input = fn tab :: NameOpt => fn name :: FieldName
=> ,
InputInitialized = fn tab :: NameOpt => fn name :: FieldName => fn v : text
=> }
con textField = fn name : text =>
pack text
with textFieldBody name
as crudField
end
con inserter =
fold exp (fn fs :: Type => {Exp(Context(Empty(Type), _))})
(fn tname :: NameOpt => fn name :: FieldName =>
fn t :: Type =>
fn tail :: {Type} =>
fn v : t => fn acc :: {Exp(Context(Empty(Type), _))} =>
[[@@tname.name : SqlExp({v})]] ++ acc)
(Empty(Exp(Context(Empty(Type), _))))
con leaver =
fold (fn fs :: Type => {Type})
(fn tname :: NameOpt => fn name :: FieldName =>
fn t :: Type =>
fn tail :: {Type} =>
fn acc :: {Type} =>
[[name : t]] ++ acc)
(Empty(Type))
val crud = fn fs ::: {Exists crudField} => fn tab :: Table([[#Id : idField]] ++ fs) =>
fn seq :: Sequence =>
let
val rec list = fn () =>
Listing items
{(SELECT T.Id FROM tab AS T)
(fn r : $[[@@T.#Id : integer]] => fn b => {b}
#
[Edit]
[Delete]
)
}
Add a new one
and view = fn id => fn () =>
Viewing item #
{(SELECT T.*fs
FROM tab AS T
WHERE T.Id = {id})
(fn r => fn b =>
fold (fn t :: {Exists crudField} => bodyTags)
(fn tname :: NameOpt => fn name :: FieldName =>
fn t :: Exists crudField =>
fn tail :: {Exists crudField} =>
fn v : t => fn acc : bodyTags =>
unpack v as v2 : t2 with vr in
:
{#ToHtml vr v2}
{acc}
end)
b [Enter(T, fs)] r)
}
Back to that list
and create = fn () =>
Adding an item
end)
[fs]}
and add = fn vs : $fs =>
((INSERT INTO tab
{[[#Id : SqlExp({nextval(seq)})]]
++ inserter fs [vs]}) ();
Adding an item, Part II
)
and edit = fn id => fn () =>
Editing something
{(SELECT T.*fs
FROM tab AS T
WHERE T.Id = {id})
(fn r => fn b =>
end)
[Enter(T, fs)] r}
) }
and save = fn id => fn vs : $(leaver fs) =>
((UPDATE tab AS T
SET {inserter (leaver fs) [vs]}
WHERE T.Id = {id}) ();
Saving an item
)
and confirm = fn id => fn () =>
Deleting an item
Are you sure you want to delete #?
I was born ready!
and delete = fn id => fn () =>
((DELETE FROM tab AS T
WHERE T.Id = {id}) ();
Really deleting an item
It is done.
)
in
list
end