Mercurial > urweb
comparison src/sql.sml @ 2238:7f92d70a326e
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, |