Mercurial > urweb

changeset 1204:7af5e2af64f4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Parsed a WHERE clause
author Adam Chlipala <adamc@hcoop.net>
date Sun, 04 Apr 2010 17:11:22 -0400
parents a75c66dd2aeb
children 7cd11380cdf1
files src/iflow.sml tests/policy.ur
diffstat 2 files changed, 67 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/src/iflow.sml	Sun Apr 04 16:44:34 2010 -0400
+++ b/src/iflow.sml	Sun Apr 04 17:11:22 2010 -0400
@@ -385,6 +385,11 @@
         NONE => p2 chs
       | v => v
 
+fun opt p chs =
+    case p chs of
+        NONE => SOME (NONE, chs)
+      | SOME (v, chs) => SOME (SOME v, chs)
+
 fun skip cp chs =
     case chs of
         String "" :: chs => skip cp chs
@@ -412,7 +417,14 @@
         end
       | _ => NONE
 
-fun ws p = wrap (follow p (skip (fn ch => ch = #" "))) #1
+fun ws p = wrap (follow (skip (fn ch => ch = #" "))
+                        (follow p (skip (fn ch => ch = #" ")))) (#1 o #2)
+
+fun log name p chs =
+    (case chs of
+         String s :: [] => print (name ^ ": " ^ s ^ "\n")
+       | _ => print (name ^ ": blocked!\n");
+     p chs)
 
 fun list p chs =
     (alt (wrap (follow p (follow (ws (const ",")) (list p)))
@@ -436,6 +448,34 @@
                                  uw_ident))
                  (fn (t, ((), f)) => (t, f))
 
+datatype sqexp =
+         Field of string * string
+       | Binop of string * sqexp * sqexp
+
+val sqbrel = wrap (const "=") (fn () => "=")
+
+datatype ('a, 'b) sum = inl of 'a | inr of 'b
+
+fun sqexp chs =
+    alt
+        (wrap (follow (ws (const "("))
+                      (follow (ws sqexp)
+                              (ws (const ")"))))
+              (fn ((), (e, ())) => e))
+         (wrap
+              (follow (wrap sitem Field)
+                      (alt
+                           (wrap
+                                (follow (ws sqbrel)
+                                        (ws sqexp))
+                                inl)
+                           (always (inr ()))))
+              (fn (e1, sm) =>
+                  case sm of
+                      inl (bo, e2) => Binop (bo, e1, e2)
+                    | inr () => e1))
+         chs
+     
 val select = wrap (follow (const "SELECT ") (list sitem))
                   (fn ((), ls) => ls)
 
@@ -447,12 +487,15 @@
 val from = wrap (follow (const "FROM ") (list fitem))
                 (fn ((), ls) => ls)
 
-val query = wrap (follow select from)
-            (fn (fs, ts) => {Select = fs, From = ts})
+val wher = wrap (follow (ws (const "WHERE ")) sqexp)
+           (fn ((), ls) => ls)
+
+val query = wrap (follow (follow select from) (opt wher))
+            (fn ((fs, ts), wher) => {Select = fs, From = ts, Where = wher})
 
 fun queryProp rv oe e =
     case parse query e of
-        NONE => Unknown
+        NONE => (print "Crap\n"; Unknown)
       | SOME r =>
         let
             val p =
--- a/tests/policy.ur	Sun Apr 04 16:44:34 2010 -0400
+++ b/tests/policy.ur	Sun Apr 04 17:11:22 2010 -0400
@@ -1,12 +1,27 @@
-table fruit : { Id : int, Nam : string, Weight : float, Secret : string }
+type fruit = int
+table fruit : { Id : fruit, Nam : string, Weight : float, Secret : string }
+  PRIMARY KEY Id,
+  CONSTRAINT Nam UNIQUE Nam
+
+type order = int
+table order : { Id : order, Fruit : fruit, Qty : int, Code : int }
+  PRIMARY KEY Id,
+  CONSTRAINT Fruit FOREIGN KEY Fruit REFERENCES fruit(Id)
 
 policy query_policy (SELECT fruit.Id, fruit.Nam, fruit.Weight FROM fruit)
+policy query_policy (SELECT order.Id, order.Fruit, order.Qty FROM order)
 
 fun main () =
-    xml <- queryX (SELECT fruit.Id, fruit.Nam
-                   FROM fruit)
-           (fn x => <xml><li>{[x.Fruit.Id]}: {[x.Fruit.Nam]}</li></xml>);
+    x1 <- queryX (SELECT fruit.Id, fruit.Nam
+                  FROM fruit)
+                 (fn x => <xml><li>{[x.Fruit.Id]}: {[x.Fruit.Nam]}</li></xml>);
+
+    x2 <- queryX (SELECT fruit.Nam, order.Qty
+                  FROM fruit, order
+                  WHERE order.Fruit = fruit.Id)
+                 (fn x => <xml><li>{[x.Fruit.Nam]}: {[x.Order.Qty]}</li></xml>);
 
     return <xml><body>
-      {xml}
+      <ul>{x1}</ul>
+      <ul>{x2}</ul>
     </body></xml>