Mercurial > urweb

comparison demo/more/orm.ur @ 989:0bdc4d538f1c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Orm searching
author Adam Chlipala <adamc@hcoop.net>
date Mon, 05 Oct 2009 17:24:21 -0400
parents d923b47e483d
children 46803e668a89
comparison
equal deleted inserted replaced
988:d923b47e483d 989:0bdc4d538f1c
14 type id = int 14 type id = int
15 val inj = _ 15 val inj = _
16 val id : meta id = {Link = (), 16 val id : meta id = {Link = (),
17 Inj = inj} 17 Inj = inj}
18 18
19 con fs = [Id = id] ++ M.cols
20
19 sequence s 21 sequence s
20 table t : ([Id = id] ++ M.cols) 22 table t : fs
21 23
22 type row = $([Id = id] ++ M.cols) 24 type row = $fs
23 25
24 fun ensql [avail] (r : $M.cols) : $(map (sql_exp avail [] []) M.cols) = 26 fun ensql [avail] (r : $M.cols) : $(map (sql_exp avail [] []) M.cols) =
25 map2 [meta] [Top.id] [sql_exp avail [] []] 27 map2 [meta] [Top.id] [sql_exp avail [] []]
26 (fn [t] meta v => @sql_inject meta.Inj v) 28 (fn [t] meta v => @sql_inject meta.Inj v)
27 [_] M.folder M.cols r 29 [_] M.folder M.cols r
37 39
38 fun lookup id = 40 fun lookup id =
39 ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]}); 41 ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]});
40 return (Option.mp (fn r => r.T) ro) 42 return (Option.mp (fn r => r.T) ro)
41 43
42 val list = query (SELECT * FROM t) (fn r ls => return (r.T :: ls)) [] 44 fun resultsOut q = query q (fn r ls => return (r.T :: ls)) []
45
46 val list = resultsOut (SELECT * FROM t)
47
48 con col = fn t => {Exp : sql_exp [T = fs] [] [] t,
49 Inj : sql_injectable t}
50 val idCol = {Exp = sql_field [#T] [#Id], Inj = _}
51 val cols = foldR [meta] [fn before => after :: {Type} -> [before ~ after] =>
52 $(map (fn t => {Exp : sql_exp [T = before ++ after] [] [] t,
53 Inj : sql_injectable t}) before)]
54 (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before] (meta : meta t)
55 (acc : after :: {Type} -> [before ~ after] =>
56 $(map (fn t => {Exp : sql_exp [T = before ++ after] [] [] t,
57 Inj : sql_injectable t}) before))
58 [after :: {Type}] [[nm = t] ++ before ~ after] =>
59 {nm = {Exp = sql_field [#T] [nm],
60 Inj = meta.Inj}} ++ acc [[nm = t] ++ after] !)
61 (fn [after :: {Type}] [[] ~ after] => {})
62 [_] M.folder M.cols
63 [[Id = id]] !
64
65 type filter = sql_exp [T = fs] [] [] bool
66 fun search (f : filter) = resultsOut (SELECT * FROM t WHERE {f})
67
68 fun bin (b : t ::: Type -> sql_binary t t bool) [t] (c : col t) (v : t) =
69 sql_binary b c.Exp (@sql_inject c.Inj v)
70 val eq = bin @@sql_eq
71 val ne = bin @@sql_ne
72 val lt = bin @@sql_lt
73 val le = bin @@sql_le
74 val gt = bin @@sql_gt
75 val ge = bin @@sql_ge
76
77 fun bb (b : sql_binary bool bool bool) (f1 : filter) (f2 : filter) =
78 sql_binary b f1 f2
79 val _and = bb sql_and
80 val or = bb sql_or
43 end 81 end