Mercurial > urweb

comparison lib/ur/top.ur @ 1394:d328983dc5a6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Allow subqueries to reference aggregate-only columns of free tables; treat non-COUNT aggregate functions as possibly returning NULL
author Adam Chlipala <adam@chlipala.net>
date Sat, 15 Jan 2011 14:53:13 -0500
parents 7dd8a6704265
children 8631e9ed0ee8
comparison
equal deleted inserted replaced
1393:802c179dac1f 1394:d328983dc5a6
213 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 213 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
214 r1 r2 r3 acc => 214 r1 r2 r3 acc =>
215 <xml>{f [nm] [t] [rest] ! r1 r2 r3}{acc}</xml>) 215 <xml>{f [nm] [t] [rest] ! r1 r2 r3}{acc}</xml>)
216 <xml/> 216 <xml/>
217 217
218 fun query1 [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [] [t = fs] []) 218 fun query1 [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [] [] [t = fs] [])
219 (f : $fs -> state -> transaction state) (i : state) = 219 (f : $fs -> state -> transaction state) (i : state) =
220 query q (fn r => f r.t) i 220 query q (fn r => f r.t) i
221 221
222 fun query1' [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [] [t = fs] []) 222 fun query1' [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [] [] [t = fs] [])
223 (f : $fs -> state -> state) (i : state) = 223 (f : $fs -> state -> state) (i : state) =
224 query q (fn r s => return (f r.t s)) i 224 query q (fn r s => return (f r.t s)) i
225 225
226 fun queryL [tables] [exps] [tables ~ exps] (q : sql_query [] tables exps) = 226 fun queryL [tables] [exps] [tables ~ exps] (q : sql_query [] [] tables exps) =
227 query q 227 query q
228 (fn r ls => return (r :: ls)) 228 (fn r ls => return (r :: ls))
229 [] 229 []
230 230
231 fun queryL1 [t ::: Name] [fs ::: {Type}] (q : sql_query [] [t = fs] []) = 231 fun queryL1 [t ::: Name] [fs ::: {Type}] (q : sql_query [] [] [t = fs] []) =
232 query q 232 query q
233 (fn r ls => return (r.t :: ls)) 233 (fn r ls => return (r.t :: ls))
234 [] 234 []
235 235
236 fun queryI [tables ::: {{Type}}] [exps ::: {Type}] 236 fun queryI [tables ::: {{Type}}] [exps ::: {Type}]
237 [tables ~ exps] (q : sql_query [] tables exps) 237 [tables ~ exps] (q : sql_query [] [] tables exps)
238 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) 238 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
239 -> transaction unit) = 239 -> transaction unit) =
240 query q 240 query q
241 (fn fs _ => f fs) 241 (fn fs _ => f fs)
242 () 242 ()
243 243
244 fun queryI1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [nm = fs] []) 244 fun queryI1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [] [nm = fs] [])
245 (f : $fs -> transaction unit) = 245 (f : $fs -> transaction unit) =
246 query q 246 query q
247 (fn fs _ => f fs.nm) 247 (fn fs _ => f fs.nm)
248 () 248 ()
249 249
250 fun queryX [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] 250 fun queryX [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
251 [tables ~ exps] (q : sql_query [] tables exps) 251 [tables ~ exps] (q : sql_query [] [] tables exps)
252 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) 252 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
253 -> xml ctx inp []) = 253 -> xml ctx inp []) =
254 query q 254 query q
255 (fn fs acc => return <xml>{acc}{f fs}</xml>) 255 (fn fs acc => return <xml>{acc}{f fs}</xml>)
256 <xml/> 256 <xml/>
257 257
258 fun queryX1 [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] 258 fun queryX1 [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
259 (q : sql_query [] [nm = fs] []) 259 (q : sql_query [] [] [nm = fs] [])
260 (f : $fs -> xml ctx inp []) = 260 (f : $fs -> xml ctx inp []) =
261 query q 261 query q
262 (fn fs acc => return <xml>{acc}{f fs.nm}</xml>) 262 (fn fs acc => return <xml>{acc}{f fs.nm}</xml>)
263 <xml/> 263 <xml/>
264 264
265 fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] 265 fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
266 [tables ~ exps] (q : sql_query [] tables exps) 266 [tables ~ exps] (q : sql_query [] [] tables exps)
267 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) 267 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
268 -> transaction (xml ctx inp [])) = 268 -> transaction (xml ctx inp [])) =
269 query q 269 query q
270 (fn fs acc => 270 (fn fs acc =>
271 r <- f fs; 271 r <- f fs;
272 return <xml>{acc}{r}</xml>) 272 return <xml>{acc}{r}</xml>)
273 <xml/> 273 <xml/>
274 274
275 fun queryX1' [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] 275 fun queryX1' [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
276 (q : sql_query [] [nm = fs] []) 276 (q : sql_query [] [] [nm = fs] [])
277 (f : $fs -> transaction (xml ctx inp [])) = 277 (f : $fs -> transaction (xml ctx inp [])) =
278 query q 278 query q
279 (fn fs acc => 279 (fn fs acc =>
280 r <- f fs.nm; 280 r <- f fs.nm;
281 return <xml>{acc}{r}</xml>) 281 return <xml>{acc}{r}</xml>)
282 <xml/> 282 <xml/>
283 283
284 fun queryXE' [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] 284 fun queryXE' [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
285 (q : sql_query [] [] exps) 285 (q : sql_query [] [] [] exps)
286 (f : $exps -> transaction (xml ctx inp [])) = 286 (f : $exps -> transaction (xml ctx inp [])) =
287 query q 287 query q
288 (fn fs acc => 288 (fn fs acc =>
289 r <- f fs; 289 r <- f fs;
290 return <xml>{acc}{r}</xml>) 290 return <xml>{acc}{r}</xml>)
291 <xml/> 291 <xml/>
292 292
293 fun hasRows [tables ::: {{Type}}] [exps ::: {Type}] 293 fun hasRows [tables ::: {{Type}}] [exps ::: {Type}]
294 [tables ~ exps] 294 [tables ~ exps]
295 (q : sql_query [] tables exps) = 295 (q : sql_query [] [] tables exps) =
296 query q 296 query q
297 (fn _ _ => return True) 297 (fn _ _ => return True)
298 False 298 False
299 299
300 fun oneOrNoRows [tables ::: {{Type}}] [exps ::: {Type}] 300 fun oneOrNoRows [tables ::: {{Type}}] [exps ::: {Type}]
301 [tables ~ exps] 301 [tables ~ exps]
302 (q : sql_query [] tables exps) = 302 (q : sql_query [] [] tables exps) =
303 query q 303 query q
304 (fn fs _ => return (Some fs)) 304 (fn fs _ => return (Some fs))
305 None 305 None
306 306
307 fun oneOrNoRows1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [nm = fs] []) = 307 fun oneOrNoRows1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [] [nm = fs] []) =
308 query q 308 query q
309 (fn fs _ => return (Some fs.nm)) 309 (fn fs _ => return (Some fs.nm))
310 None 310 None
311 311
312 fun oneOrNoRowsE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query [] (mapU [] tabs) [nm = t]) = 312 fun oneOrNoRowsE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query [] [] (mapU [] tabs) [nm = t]) =
313 query q 313 query q
314 (fn fs _ => return (Some fs.nm)) 314 (fn fs _ => return (Some fs.nm))
315 None 315 None
316 316
317 fun oneRow [tables ::: {{Type}}] [exps ::: {Type}] 317 fun oneRow [tables ::: {{Type}}] [exps ::: {Type}]
318 [tables ~ exps] (q : sql_query [] tables exps) = 318 [tables ~ exps] (q : sql_query [] [] tables exps) =
319 o <- oneOrNoRows q; 319 o <- oneOrNoRows q;
320 return (case o of 320 return (case o of
321 None => error <xml>Query returned no rows</xml> 321 None => error <xml>Query returned no rows</xml>
322 | Some r => r) 322 | Some r => r)
323 323
324 fun oneRow1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [nm = fs] []) = 324 fun oneRow1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [] [nm = fs] []) =
325 o <- oneOrNoRows q; 325 o <- oneOrNoRows q;
326 return (case o of 326 return (case o of
327 None => error <xml>Query returned no rows</xml> 327 None => error <xml>Query returned no rows</xml>
328 | Some r => r.nm) 328 | Some r => r.nm)
329 329
330 fun oneRowE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query [] (mapU [] tabs) [nm = t]) = 330 fun oneRowE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query [] [] (mapU [] tabs) [nm = t]) =
331 o <- oneOrNoRows q; 331 o <- oneOrNoRows q;
332 return (case o of 332 return (case o of
333 None => error <xml>Query returned no rows</xml> 333 None => error <xml>Query returned no rows</xml>
334 | Some r => r.nm) 334 | Some r => r.nm)
335 335