|
adamc@987
|
1 con link = fn t :: Type => unit
|
|
adamc@987
|
2
|
|
adamc@987
|
3 con meta = fn col :: Type => {
|
|
adamc@987
|
4 Link : link col,
|
|
adamc@987
|
5 Inj : sql_injectable col
|
|
adamc@987
|
6 }
|
|
adamc@987
|
7
|
|
adamc@987
|
8 functor Table(M : sig
|
|
adamc@987
|
9 con cols :: {Type}
|
|
adamc@987
|
10 val cols : $(map meta cols)
|
|
adamc@987
|
11 constraint [Id] ~ cols
|
|
adamc@987
|
12 val folder : folder cols
|
|
adamc@987
|
13 end) = struct
|
|
adamc@987
|
14 type id = int
|
|
adamc@987
|
15 val inj = _
|
|
adamc@987
|
16 val id : meta id = {Link = (),
|
|
adamc@987
|
17 Inj = inj}
|
|
adamc@987
|
18
|
|
adamc@989
|
19 con fs = [Id = id] ++ M.cols
|
|
adamc@989
|
20
|
|
adamc@987
|
21 sequence s
|
|
adamc@989
|
22 table t : fs
|
|
adamc@987
|
23
|
|
adamc@989
|
24 type row = $fs
|
|
adamc@988
|
25
|
|
adamc@988
|
26 fun ensql [avail] (r : $M.cols) : $(map (sql_exp avail [] []) M.cols) =
|
|
adamc@988
|
27 map2 [meta] [Top.id] [sql_exp avail [] []]
|
|
adamc@988
|
28 (fn [t] meta v => @sql_inject meta.Inj v)
|
|
adamc@988
|
29 [_] M.folder M.cols r
|
|
adamc@988
|
30
|
|
adamc@987
|
31 fun create (r : $M.cols) =
|
|
adamc@987
|
32 id <- nextval s;
|
|
adamc@988
|
33 dml (insert t ({Id = sql_inject id} ++ ensql r));
|
|
adamc@988
|
34 return ({Id = id} ++ r)
|
|
adamc@988
|
35
|
|
adamc@988
|
36 fun delete r = dml (DELETE FROM t WHERE t.Id = {[r.Id]})
|
|
adamc@988
|
37
|
|
adamc@988
|
38 fun save r = dml (update [M.cols] ! (ensql (r -- #Id)) t (WHERE T.Id = {[r.Id]}))
|
|
adamc@988
|
39
|
|
adamc@988
|
40 fun lookup id =
|
|
adamc@988
|
41 ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]});
|
|
adamc@988
|
42 return (Option.mp (fn r => r.T) ro)
|
|
adamc@988
|
43
|
|
adamc@989
|
44 fun resultsOut q = query q (fn r ls => return (r.T :: ls)) []
|
|
adamc@989
|
45
|
|
adamc@989
|
46 val list = resultsOut (SELECT * FROM t)
|
|
adamc@989
|
47
|
|
adamc@989
|
48 con col = fn t => {Exp : sql_exp [T = fs] [] [] t,
|
|
adamc@989
|
49 Inj : sql_injectable t}
|
|
adamc@989
|
50 val idCol = {Exp = sql_field [#T] [#Id], Inj = _}
|
|
adamc@989
|
51 val cols = foldR [meta] [fn before => after :: {Type} -> [before ~ after] =>
|
|
adamc@989
|
52 $(map (fn t => {Exp : sql_exp [T = before ++ after] [] [] t,
|
|
adamc@989
|
53 Inj : sql_injectable t}) before)]
|
|
adamc@989
|
54 (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before] (meta : meta t)
|
|
adamc@989
|
55 (acc : after :: {Type} -> [before ~ after] =>
|
|
adamc@989
|
56 $(map (fn t => {Exp : sql_exp [T = before ++ after] [] [] t,
|
|
adamc@989
|
57 Inj : sql_injectable t}) before))
|
|
adamc@989
|
58 [after :: {Type}] [[nm = t] ++ before ~ after] =>
|
|
adamc@989
|
59 {nm = {Exp = sql_field [#T] [nm],
|
|
adamc@989
|
60 Inj = meta.Inj}} ++ acc [[nm = t] ++ after] !)
|
|
adamc@989
|
61 (fn [after :: {Type}] [[] ~ after] => {})
|
|
adamc@989
|
62 [_] M.folder M.cols
|
|
adamc@989
|
63 [[Id = id]] !
|
|
adamc@989
|
64
|
|
adamc@989
|
65 type filter = sql_exp [T = fs] [] [] bool
|
|
adamc@989
|
66 fun search (f : filter) = resultsOut (SELECT * FROM t WHERE {f})
|
|
adamc@989
|
67
|
|
adamc@989
|
68 fun bin (b : t ::: Type -> sql_binary t t bool) [t] (c : col t) (v : t) =
|
|
adamc@989
|
69 sql_binary b c.Exp (@sql_inject c.Inj v)
|
|
adamc@989
|
70 val eq = bin @@sql_eq
|
|
adamc@989
|
71 val ne = bin @@sql_ne
|
|
adamc@989
|
72 val lt = bin @@sql_lt
|
|
adamc@989
|
73 val le = bin @@sql_le
|
|
adamc@989
|
74 val gt = bin @@sql_gt
|
|
adamc@989
|
75 val ge = bin @@sql_ge
|
|
adamc@989
|
76
|
|
adamc@989
|
77 fun bb (b : sql_binary bool bool bool) (f1 : filter) (f2 : filter) =
|
|
adamc@989
|
78 sql_binary b f1 f2
|
|
adamc@989
|
79 val _and = bb sql_and
|
|
adamc@989
|
80 val or = bb sql_or
|
|
adamc@987
|
81 end
|
