Mercurial > urweb

changeset 1209:775357041e48

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Parsing float and string SQL literals
author Adam Chlipala <adamc@hcoop.net>
date Tue, 06 Apr 2010 11:07:19 -0400
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