# HG changeset patch
# User Karn Kallio <kkallio@eka>
# Date 1318575783 16200
# Node ID 5530a8075b62ef11f4177931c2d70b05bfc75ebb
# Parent  f403e129c276e06a1d6936898531689b3528feb6
IF THEN ELSE conditional for SQL.

diff -r f403e129c276 -r 5530a8075b62 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Sat Oct 08 17:23:58 2011 -0400
+++ b/lib/ur/basis.urs	Fri Oct 14 02:33:03 2011 -0430
@@ -474,6 +474,13 @@
                   -> sql_exp tables agg exps (option t)
                   -> sql_exp tables agg exps bool
 
+val sql_if_then_else : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                       -> t ::: Type
+                       -> sql_exp tables agg exps bool
+                       -> sql_exp tables agg exps t
+                       -> sql_exp tables agg exps t
+                       -> sql_exp tables agg exps t
+
 class sql_arith
 val sql_arith_int : sql_arith int
 val sql_arith_float : sql_arith float
diff -r f403e129c276 -r 5530a8075b62 src/elisp/urweb-mode.el
--- a/src/elisp/urweb-mode.el	Sat Oct 08 17:23:58 2011 -0400
+++ b/src/elisp/urweb-mode.el	Fri Oct 14 02:33:03 2011 -0430
@@ -150,7 +150,8 @@
                  "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE"
                  "PRIMARY" "KEY" "CONSTRAINT" "UNIQUE" "CHECK"
                  "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL"
-                 "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1")
+                 "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1"
+                 "IF" "THEN" "ELSE")
   "A regexp that matches SQL keywords.")
 
 (defconst urweb-lident-regexp "\\<[a-z_][A-Za-z0-9_']*\\>"
diff -r f403e129c276 -r 5530a8075b62 src/monoize.sml
--- a/src/monoize.sml	Sat Oct 08 17:23:58 2011 -0400
+++ b/src/monoize.sml	Fri Oct 14 02:33:03 2011 -0430
@@ -2804,6 +2804,31 @@
                  fm)
             end
 
+          | (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_if_then_else"), _), _),
+                _), _),
+               _), _),
+              _), _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                fun sc s = (L'.EPrim (Prim.String s), loc)
+            in
+                ((L'.EAbs ("if", s, (L'.TFun (s, s), loc),
+                           (L'.EAbs ("then", s, (L'.TFun (s, s), loc),
+                                     (L'.EAbs ("else", s, (L'.TFun (s, s), loc),
+                                               strcat [sc "(CASE WHEN (",
+                                                       (L'.ERel 2, loc),
+                                                       sc ") THEN (",
+                                                       (L'.ERel 1, loc),
+                                                       sc ") ELSE (",
+                                                       (L'.ERel 0, loc),
+                                                       sc ") END)"]), loc)), loc)), loc),
+                 fm)
+            end
+
           | L.ECApp (
             (L.ECApp (
              (L.ECApp (
diff -r f403e129c276 -r 5530a8075b62 src/urweb.grm
--- a/src/urweb.grm	Sat Oct 08 17:23:58 2011 -0400
+++ b/src/urweb.grm	Fri Oct 14 02:33:03 2011 -0430
@@ -249,6 +249,7 @@
  | NE | LT | LE | GT | GE
  | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
  | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
+ | CIF | CTHEN | CELSE
 
 %nonterm
    file of decl list
@@ -1828,6 +1829,13 @@
                                                     sqlexp), loc)
                                          end)
 
+       | CIF sqlexp CTHEN sqlexp CELSE sqlexp (let
+                                                   val loc = s (CIFleft, sqlexp3right)
+                                                   val e = (EVar (["Basis"], "sql_if_then_else", Infer), loc) 
+                                               in
+                                                   (EApp ((EApp ((EApp (e, sqlexp1), loc), sqlexp2), loc), sqlexp3), loc)
+                                               end)
+
        | LBRACE LBRACK eexp RBRACK RBRACE  (sql_inject (#1 eexp,
                                                         s (LBRACEleft, RBRACEright)))
        | LPAREN sqlexp RPAREN           (sqlexp)
diff -r f403e129c276 -r 5530a8075b62 src/urweb.lex
--- a/src/urweb.lex	Sat Oct 08 17:23:58 2011 -0400
+++ b/src/urweb.lex	Fri Oct 14 02:33:03 2011 -0430
@@ -480,6 +480,10 @@
 <INITIAL> "MIN"       => (Tokens.MIN (pos yypos, pos yypos + size yytext));
 <INITIAL> "MAX"       => (Tokens.MAX (pos yypos, pos yypos + size yytext));
 
+<INITIAL> "IF"        => (Tokens.CIF (pos yypos, pos yypos + size yytext));
+<INITIAL> "THEN"      => (Tokens.CTHEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "ELSE"      => (Tokens.CELSE (pos yypos, pos yypos + size yytext));
+
 <INITIAL> "ASC"       => (Tokens.ASC (pos yypos, pos yypos + size yytext));
 <INITIAL> "DESC"      => (Tokens.DESC (pos yypos, pos yypos + size yytext));