Mercurial > urweb

comparison demo/more/orm.ur @ 1778:818d4097e2ed

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Lighter-weight encoding of window function use
author Adam Chlipala <adam@chlipala.net>
date Sun, 03 Jun 2012 11:29:31 -0400
parents 6bc2a8cb3a67
children
comparison
equal deleted inserted replaced
1777:59b07fdae1ff 1778:818d4097e2ed
30 30
31 val inj = _ 31 val inj = _
32 val id = {Link = fn id => resultOut (SELECT * FROM t WHERE t.Id = {[id]}), 32 val id = {Link = fn id => resultOut (SELECT * FROM t WHERE t.Id = {[id]}),
33 Inj = inj} 33 Inj = inj}
34 34
35 fun ensql [avail ::_] (r : row') : $(map (sql_exp avail [] [] disallow_window) fs') = 35 fun ensql [avail ::_] (r : row') : $(map (sql_exp avail [] []) fs') =
36 @map2 [meta] [fst] [fn ts :: (Type * Type) => sql_exp avail [] [] disallow_window ts.1] 36 @map2 [meta] [fst] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1]
37 (fn [ts] meta v => @sql_inject meta.Inj v) 37 (fn [ts] meta v => @sql_inject meta.Inj v)
38 M.folder M.cols r 38 M.folder M.cols r
39 39
40 fun create (r : row') = 40 fun create (r : row') =
41 id <- nextval s; 41 id <- nextval s;
51 return (Option.mp (fn r => r.T) ro) 51 return (Option.mp (fn r => r.T) ro)
52 52
53 53
54 val list = resultsOut (SELECT * FROM t) 54 val list = resultsOut (SELECT * FROM t)
55 55
56 con col = fn t => {Exp : sql_exp [T = fs] [] [] disallow_window t, 56 con col = fn t => {Exp : sql_exp [T = fs] [] [] t,
57 Inj : sql_injectable t} 57 Inj : sql_injectable t}
58 val idCol = {Exp = sql_field [#T] [#Id], Inj = _} 58 val idCol = {Exp = sql_field [#T] [#Id], Inj = _}
59 con meta' = fn (fs :: {Type}) (col :: Type, parent :: Type) => 59 con meta' = fn (fs :: {Type}) (col :: Type, parent :: Type) =>
60 {Col : {Exp : sql_exp [T = fs] [] [] disallow_window col, 60 {Col : {Exp : sql_exp [T = fs] [] [] col,
61 Inj : sql_injectable col}, 61 Inj : sql_injectable col},
62 Parent : $fs -> transaction (option parent)} 62 Parent : $fs -> transaction (option parent)}
63 val cols = @foldR [meta] [fn before => after :: {(Type * Type)} -> [before ~ after] => 63 val cols = @foldR [meta] [fn before => after :: {(Type * Type)} -> [before ~ after] =>
64 $(map (meta' (map fst (before ++ after))) before)] 64 $(map (meta' (map fst (before ++ after))) before)]
65 (fn [nm :: Name] [ts :: (Type * Type)] [before :: {(Type * Type)}] 65 (fn [nm :: Name] [ts :: (Type * Type)] [before :: {(Type * Type)}]
73 ++ acc [[nm = ts] ++ after]) 73 ++ acc [[nm = ts] ++ after])
74 (fn [after :: {(Type * Type)}] [[] ~ after] => {}) 74 (fn [after :: {(Type * Type)}] [[] ~ after] => {})
75 M.folder M.cols 75 M.folder M.cols
76 [[Id = (id, row)]] ! 76 [[Id = (id, row)]] !
77 77
78 type filter = sql_exp [T = fs] [] [] disallow_window bool 78 type filter = sql_exp [T = fs] [] [] bool
79 fun find (f : filter) = resultOut (SELECT * FROM t WHERE {f}) 79 fun find (f : filter) = resultOut (SELECT * FROM t WHERE {f})
80 fun search (f : filter) = resultsOut (SELECT * FROM t WHERE {f}) 80 fun search (f : filter) = resultsOut (SELECT * FROM t WHERE {f})
81 81
82 fun bin (b : t ::: Type -> sql_binary t t bool) [t] (c : col t) (v : t) = 82 fun bin (b : t ::: Type -> sql_binary t t bool) [t] (c : col t) (v : t) =
83 sql_binary b c.Exp (@sql_inject c.Inj v) 83 sql_binary b c.Exp (@sql_inject c.Inj v)