Mercurial > urweb
changeset 1209:775357041e48
Parsing float and string SQL literals
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 06 Apr 2010 11:07:19 -0400 (2010-04-06) |
parents | b5a4c5407ae0 |
children | c5bd970e77a5 |
files | src/iflow.sml tests/policy.ur |
diffstat | 2 files changed, 45 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- a/src/iflow.sml Tue Apr 06 10:39:15 2010 -0400 +++ b/src/iflow.sml Tue Apr 06 11:07:19 2010 -0400 @@ -585,6 +585,14 @@ NONE => NONE | SOME (v, chs) => SOME (f v, chs) +fun wrapP p f chs = + case p chs of + NONE => NONE + | SOME (v, chs) => + case f v of + NONE => NONE + | SOME r => SOME (r, chs) + fun alt p1 p2 chs = case p1 chs of NONE => p2 chs @@ -679,24 +687,42 @@ datatype ('a, 'b) sum = inl of 'a | inr of 'b -fun int chs = +fun string chs = case chs of - String s :: chs' => - let - val (befor, after) = Substring.splitl Char.isDigit (Substring.full s) - in - if Substring.isEmpty befor then - NONE - else case Int64.fromString (Substring.string befor) of - NONE => NONE - | SOME n => SOME (n, if Substring.isEmpty after then - chs' - else - String (Substring.string after) :: chs') - end - | _ => NONE + String s :: chs => + if size s >= 2 andalso String.sub (s, 0) = #"'" then + let + fun loop (cs, acc) = + case cs of + [] => NONE + | c :: cs => + if c = #"'" then + SOME (String.implode (rev acc), cs) + else if c = #"\\" then + case cs of + c :: cs => loop (cs, c :: acc) + | _ => raise Fail "Iflow.string: Unmatched backslash escape" + else + loop (cs, c :: acc) + in + case loop (String.explode (String.extract (s, 1, NONE)), []) of + NONE => NONE + | SOME (s, []) => SOME (s, chs) + | SOME (s, cs) => SOME (s, String (String.implode cs) :: chs) + end + else + NONE + | _ => NONE -val prim = wrap (follow (wrap int Prim.Int) (opt (const "::int8"))) #1 +val prim = + altL [wrap (follow (wrapP (follow (keep Char.isDigit) (follow (const ".") (keep Char.isDigit))) + (fn (x, ((), y)) => Option.map Prim.Float (Real64.fromString (x ^ "." ^ y)))) + (opt (const "::float8"))) #1, + wrap (follow (wrapP (keep Char.isDigit) + (Option.map Prim.Int o Int64.fromString)) + (opt (const "::int8"))) #1, + wrap (follow (opt (const "E")) (follow string (opt (const "::text")))) + (Prim.String o #1 o #2)] fun known' chs = case chs of
--- a/tests/policy.ur Tue Apr 06 10:39:15 2010 -0400 +++ b/tests/policy.ur Tue Apr 06 11:07:19 2010 -0400 @@ -35,7 +35,9 @@ fun main () = x1 <- queryX (SELECT fruit.Id, fruit.Nam - FROM fruit) + FROM fruit + WHERE fruit.Nam = "apple" + AND fruit.Weight = 1.23) (fn x => <xml><li>{[x.Fruit.Id]}: {[x.Fruit.Nam]}</li></xml>); x2 <- queryX (SELECT fruit.Nam, order.Qty