Mercurial > urweb

comparison src/sql.sml @ 2238:7f92d70a326e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Only use string (rather than numeric, etc.) primitives in parsed SQL statements.
author Ziv Scully <ziv@mit.edu>
date Mon, 06 Jul 2015 01:31:04 -0700
parents 0aae15c2a05a
children f70a91f7810d
comparison
equal deleted inserted replaced
2237:e79ef5792c8b 2238:7f92d70a326e
148 if Substring.isEmpty after then 148 if Substring.isEmpty after then
149 chs' 149 chs'
150 else 150 else
151 String (Substring.string after) :: chs') 151 String (Substring.string after) :: chs')
152 end 152 end
153 | _ => NONE
154
155 (* Used by primSqlcache. *)
156 fun optConst s chs =
157 case chs of
158 String s' :: chs => if String.isPrefix s s' then
159 SOME (s, if size s = size s' then
160 chs
161 else
162 String (String.extract (s', size s, NONE)) :: chs)
163 else
164 SOME ("", String s' :: chs)
153 | _ => NONE 165 | _ => NONE
154 166
155 fun ws p = wrap (follow (skip (fn ch => ch = #" ")) 167 fun ws p = wrap (follow (skip (fn ch => ch = #" "))
156 (follow p (skip (fn ch => ch = #" ")))) (#1 o #2) 168 (follow p (skip (fn ch => ch = #" ")))) (#1 o #2)
157 169
254 (Option.map Prim.Int o Int64.fromString)) 266 (Option.map Prim.Int o Int64.fromString))
255 (opt (const "::int8"))) #1, 267 (opt (const "::int8"))) #1,
256 wrap (follow (opt (const "E")) (follow string (opt (const "::text")))) 268 wrap (follow (opt (const "E")) (follow string (opt (const "::text"))))
257 ((fn s => Prim.String (Prim.Normal, s)) o #1 o #2)] 269 ((fn s => Prim.String (Prim.Normal, s)) o #1 o #2)]
258 270
271 val primSqlcache =
272 (* Like [prim], but always uses [Prim.String]s. *)
273 let
274 fun wrapS p f = wrap p ((fn s => Prim.String (Prim.Normal, s)) o f)
275 in
276 altL [wrapS (follow (wrap (follow (keep Char.isDigit)
277 (follow (const ".") (keep Char.isDigit)))
278 (fn (x, ((), y)) => x ^ "." ^ y))
279 (optConst "::float8"))
280 op^,
281 wrapS (follow (keep Char.isDigit)
282 (optConst "::int8"))
283 op^,
284 wrapS (follow (optConst "E") (follow string (optConst "::text")))
285 (fn (c1, (s, c2)) => c1 ^ s ^ c2)]
286 end
287
259 fun known' chs = 288 fun known' chs =
260 case chs of 289 case chs of
261 Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs) 290 Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs)
262 | _ => NONE 291 | _ => NONE
263 292
276 305
277 | _ => NONE 306 | _ => NONE
278 307
279 fun sqlifySqlcache chs = 308 fun sqlifySqlcache chs =
280 case chs of 309 case chs of
281 (* Could have variables as well as FFIs. *) 310 (* Could have variables or constants as well as FFIs. *)
282 Exp (e as (ERel _, _)) :: chs => SOME (e, chs) 311 Exp (e as (ERel _, _)) :: chs => SOME (e, chs)
283 (* If it is an FFI, match the entire expression. *) 312 (* If it is an FFI, match the entire expression. *)
284 | Exp (e as (EFfiApp ("Basis", f, [(_, _)]), _)) :: chs => 313 | Exp (e as (EFfiApp ("Basis", f, [(_, _)]), _)) :: chs =>
285 if String.isPrefix "sqlify" f then 314 if String.isPrefix "sqlify" f then
286 SOME (e, chs) 315 SOME (e, chs)
287 else 316 else
288 NONE 317 NONE
289 | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _), 318 | _ => sqlify chs
290 (EPrim (Prim.String (Prim.Normal, "TRUE")), _)),
291 ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _),
292 (EPrim (Prim.String (Prim.Normal, "FALSE")), _))], _), _) :: chs =>
293 SOME (e, chs)
294
295 | _ => NONE
296 319
297 fun constK s = wrap (const s) (fn () => s) 320 fun constK s = wrap (const s) (fn () => s)
298 321
299 val funcName = altL [constK "COUNT", 322 val funcName = altL [constK "COUNT",
300 constK "MIN", 323 constK "MIN",
307 330
308 val sqlcacheMode = ref false; 331 val sqlcacheMode = ref false;
309 332
310 fun sqexp chs = 333 fun sqexp chs =
311 log "sqexp" 334 log "sqexp"
312 (altL [wrap prim SqConst, 335 (altL [wrap (if !sqlcacheMode then primSqlcache else prim) SqConst,
313 wrap (const "TRUE") (fn () => SqTrue), 336 wrap (const "TRUE") (fn () => SqTrue),
314 wrap (const "FALSE") (fn () => SqFalse), 337 wrap (const "FALSE") (fn () => SqFalse),
315 wrap (const "NULL") (fn () => Null), 338 wrap (const "NULL") (fn () => Null),
316 wrap field Field, 339 wrap field Field,
317 wrap uw_ident Computed, 340 wrap uw_ident Computed,