RIGHT and FULL JOIN

5 files changed, 111 insertions, 2 deletions

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index a67d007a..c80dde7c 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -246,6 +246,21 @@ val sql_left_join : tabs1 ::: {{Type}} -> tabs2 ::: {{(Type * Type)}}
        -> sql_exp (tabs1 ++ map (map (fn p :: (Type * Type) => p.1)) tabs2) [] [] bool
        -> sql_from_items (tabs1 ++ map (map (fn p :: (Type * Type) => p.2)) tabs2)
 
+val sql_right_join : tabs1 ::: {{(Type * Type)}} -> tabs2 ::: {{Type}}
+                     -> [tabs1 ~ tabs2]
+    => $(map (fn r => $(map (fn p :: (Type * Type) => nullify p.1 p.2) r)) tabs1)
+       -> sql_from_items (map (map (fn p :: (Type * Type) => p.1)) tabs1) -> sql_from_items tabs2
+       -> sql_exp (map (map (fn p :: (Type * Type) => p.1)) tabs1 ++ tabs2) [] [] bool
+       -> sql_from_items (map (map (fn p :: (Type * Type) => p.2)) tabs1 ++ tabs2)
+
+val sql_full_join : tabs1 ::: {{(Type * Type)}} -> tabs2 ::: {{(Type * Type)}}
+                     -> [tabs1 ~ tabs2]
+    => $(map (fn r => $(map (fn p :: (Type * Type) => nullify p.1 p.2) r)) (tabs1 ++ tabs2))
+       -> sql_from_items (map (map (fn p :: (Type * Type) => p.1)) tabs1)
+       -> sql_from_items (map (map (fn p :: (Type * Type) => p.1)) tabs2)
+       -> sql_exp (map (map (fn p :: (Type * Type) => p.1)) (tabs1 ++ tabs2)) [] [] bool
+       -> sql_from_items (map (map (fn p :: (Type * Type) => p.2)) (tabs1 ++ tabs2))
+
 val sql_query1 : tables ::: {{Type}}
                  -> grouped ::: {{Type}}
                  -> selectedFields ::: {{Type}}
diff --git a/src/monoize.sml b/src/monoize.sml
index 1a502e51..16839cf9 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1781,6 +1781,45 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                 loc)), loc)), loc)), loc),
                  fm)
             end
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_right_join"), _), (L.CRecord (_, left), _)), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("_", outerRec left,
+                           (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                           (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                     (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc),
+                                               (L'.EAbs ("on", s, s,
+                                                         strcat [(L'.EPrim (Prim.String "("), loc),
+                                                                 (L'.ERel 2, loc),
+                                                                 (L'.EPrim (Prim.String " RIGHT JOIN "), loc),
+                                                                 (L'.ERel 1, loc),
+                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                 (L'.ERel 0, loc),
+                                                                 (L'.EPrim (Prim.String ")"), loc)]),
+                                                loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_full_join"), _), (L.CRecord (_, left), _)), _),
+                     (L.CRecord (_, right), _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("_", outerRec (left @ right),
+                           (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                           (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                     (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc),
+                                               (L'.EAbs ("on", s, s,
+                                                         strcat [(L'.EPrim (Prim.String "("), loc),
+                                                                 (L'.ERel 2, loc),
+                                                                 (L'.EPrim (Prim.String " FULL JOIN "), loc),
+                                                                 (L'.ERel 1, loc),
+                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                 (L'.ERel 0, loc),
+                                                                 (L'.EPrim (Prim.String ")"), loc)]),
+                                                loc)), loc)), loc)), loc),
+                 fm)
+            end
 
           | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) =>
             ((L'.EPrim (Prim.String ""), loc), fm)
diff --git a/src/urweb.grm b/src/urweb.grm
index c1f0b1ca..ce078279 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -213,7 +213,7 @@ datatype attr = Class of exp | Normal of con * exp
  | CURRENT_TIMESTAMP
  | NE | LT | LE | GT | GE
  | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
- | JOIN | INNER | CROSS | LEFT
+ | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
 
 %nonterm
    file of decl list
@@ -361,7 +361,7 @@ datatype attr = Class of exp | Normal of con * exp
 %nonassoc DCOLON TCOLON
 %left UNION INTERSECT EXCEPT
 %right COMMA
-%right JOIN INNER CROSS LEFT
+%right JOIN INNER CROSS OUTER LEFT RIGHT FULL
 %right OR
 %right CAND
 %nonassoc EQ NE LT LE GT GE IS
@@ -1478,6 +1478,56 @@ fitem  : table'                         ([#1 table'], #2 table')
                                              (#1 fitem1 @ #1 fitem2,
                                               (EApp (e, sqlexp), loc))
                                          end)
+       | fitem LEFT OUTER JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_left_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem RIGHT JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_right_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem RIGHT OUTER JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_right_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem FULL JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_full_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem FULL OUTER JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_full_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
 
 tname  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
        | LBRACE cexp RBRACE             (cexp)
diff --git a/src/urweb.lex b/src/urweb.lex
index 517054b3..bb9004a6 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -341,7 +341,10 @@ notags = [^<{\n]+;
 <INITIAL> "JOIN"      => (Tokens.JOIN (pos yypos, pos yypos + size yytext));
 <INITIAL> "INNER"     => (Tokens.INNER (pos yypos, pos yypos + size yytext));
 <INITIAL> "CROSS"     => (Tokens.CROSS (pos yypos, pos yypos + size yytext));
+<INITIAL> "OUTER"     => (Tokens.OUTER (pos yypos, pos yypos + size yytext));
 <INITIAL> "LEFT"      => (Tokens.LEFT (pos yypos, pos yypos + size yytext));
+<INITIAL> "RIGHT"     => (Tokens.RIGHT (pos yypos, pos yypos + size yytext));
+<INITIAL> "FULL"      => (Tokens.FULL (pos yypos, pos yypos + size yytext));
 
 <INITIAL> "UNION"     => (Tokens.UNION (pos yypos, pos yypos + size yytext));
 <INITIAL> "INTERSECT" => (Tokens.INTERSECT (pos yypos, pos yypos + size yytext));
diff --git a/tests/join.ur b/tests/join.ur
index 74f49eec..d6647877 100644
--- a/tests/join.ur
+++ b/tests/join.ur
@@ -6,4 +6,6 @@ fun main () =
     r <- oneRow (SELECT * FROM t AS T1 CROSS JOIN t AS T2);
     r <- oneRow (SELECT * FROM t AS T1 JOIN t AS T2 ON T1.A = T2.A);
     r <- oneRow (SELECT * FROM t AS T1 LEFT JOIN t AS T2 ON T1.A = T2.A);
+    r <- oneRow (SELECT * FROM t AS T1 RIGHT OUTER JOIN t AS T2 ON T1.A = T2.A);
+    r <- oneRow (SELECT * FROM t AS T1 FULL JOIN t AS T2 ON T1.A = T2.A);
     return <xml/>