Mercurial > urweb

comparison demo/more/versioned.ur @ 1775:6bc2a8cb3a67

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Track whether SQL expressions may use window functions, in preparation for actual window function support
author Adam Chlipala <adam@chlipala.net>
date Sat, 02 Jun 2012 15:35:58 -0400
parents 9253765d7724
children 818d4097e2ed
comparison
equal deleted inserted replaced
1774:27fdd78bd2f5 1775:6bc2a8cb3a67
22 22
23 con dmeta = fn t => {Inj : sql_injectable_prim t, 23 con dmeta = fn t => {Inj : sql_injectable_prim t,
24 Eq : eq t} 24 Eq : eq t}
25 25
26 fun keyRecd (r : $(M.key ++ M.data)) = 26 fun keyRecd (r : $(M.key ++ M.data)) =
27 @map2 [sql_injectable] [ident] [sql_exp [] [] []] 27 @map2 [sql_injectable] [ident] [sql_exp [] [] [] disallow_window]
28 (fn [t] => @sql_inject) 28 (fn [t] => @sql_inject)
29 M.keyFolder M.key (r --- M.data) 29 M.keyFolder M.key (r --- M.data)
30 30
31 fun insert r = 31 fun insert r =
32 vr <- nextval s; 32 vr <- nextval s;
33 dml (Basis.insert t 33 dml (Basis.insert t
34 ({Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)} 34 ({Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)}
35 ++ keyRecd r 35 ++ keyRecd r
36 ++ @map2 [dmeta] [ident] 36 ++ @map2 [dmeta] [ident]
37 [fn t => sql_exp [] [] [] (option t)] 37 [fn t => sql_exp [] [] [] disallow_window (option t)]
38 (fn [t] x v => @sql_inject (@sql_option_prim x.Inj) 38 (fn [t] x v => @sql_inject (@sql_option_prim x.Inj)
39 (Some v)) 39 (Some v))
40 M.dataFolder M.data (r --- M.key))) 40 M.dataFolder M.data (r --- M.key)))
41 41
42 fun keyExp (r : $M.key) : sql_exp [T = all] [] [] bool = 42 fun keyExp (r : $M.key) : sql_exp [T = all] [] [] disallow_window bool =
43 @foldR2 [sql_injectable] [ident] [fn before => after :: {Type} -> [before ~ after] 43 @foldR2 [sql_injectable] [ident] [fn before => after :: {Type} -> [before ~ after]
44 => sql_exp [T = before ++ after] [] [] bool] 44 => sql_exp [T = before ++ after] [] [] disallow_window bool]
45 (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before] 45 (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before]
46 (inj : sql_injectable t) (v : t) 46 (inj : sql_injectable t) (v : t)
47 (e : after :: {Type} -> [before ~ after] 47 (e : after :: {Type} -> [before ~ after]
48 => sql_exp [T = before ++ after] [] [] bool) 48 => sql_exp [T = before ++ after] [] [] disallow_window bool)
49 [after :: {Type}] [[nm = t] ++ before ~ after] => 49 [after :: {Type}] [[nm = t] ++ before ~ after] =>
50 (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after]})) 50 (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after]}))
51 (fn [after :: {Type}] [[] ~ after] => (SQL TRUE)) 51 (fn [after :: {Type}] [[] ~ after] => (SQL TRUE))
52 M.keyFolder M.key r 52 M.keyFolder M.key r
53 [_] ! 53 [_] !
111 case cur of 111 case cur of
112 None => error <xml>Tried to update nonexistent key</xml> 112 None => error <xml>Tried to update nonexistent key</xml>
113 | Some cur => 113 | Some cur =>
114 vr <- nextval s; 114 vr <- nextval s;
115 let 115 let
116 val r' = @map3 [dmeta] [ident] [ident] [fn t => sql_exp [] [] [] (option t)] 116 val r' = @map3 [dmeta] [ident] [ident] [fn t => sql_exp [] [] [] disallow_window (option t)]
117 (fn [t] (meta : dmeta t) old new => 117 (fn [t] (meta : dmeta t) old new =>
118 @sql_inject (@sql_option_prim meta.Inj) 118 @sql_inject (@sql_option_prim meta.Inj)
119 (if @@eq [_] meta.Eq old new then 119 (if @@eq [_] meta.Eq old new then
120 None 120 None
121 else 121 else