CURRENT_TIMESTAMP

5 files changed, 102 insertions, 59 deletions

diff --git a/lib/basis.urs b/lib/basis.urs
index ffb13330..8992bc8c 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -223,6 +223,12 @@ val sql_maxable_time : sql_maxable time
 val sql_max : t ::: Type -> sql_maxable t -> sql_aggregate t
 val sql_min : t ::: Type -> sql_maxable t -> sql_aggregate t
 
+con sql_nfunc :: Type -> Type
+val sql_nfunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                -> t ::: Type
+                -> sql_nfunc t -> sql_exp tables agg exps t
+val sql_current_timestamp : sql_nfunc time
+
 
 (*** Executing queries *)
 
diff --git a/src/monoize.sml b/src/monoize.sml
index d28b27e4..df775554 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -171,6 +171,8 @@ fun monoType env =
                     (L'.TRecord [], loc)
                   | L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) =>
                     (L'.TRecord [], loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
 
                   | L.CRel _ => poly ()
                   | L.CNamed n =>
@@ -1126,64 +1128,69 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             in
                 case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of
                     (SOME tables, SOME grouped, SOME stables, (L'.TRecord sexps, _)) =>
-                    ((L'.EAbs ("r",
-                               (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)),
-                                            ("Where", s),
-                                            ("GroupBy", un),
-                                            ("Having", s),
-                                            ("SelectFields", un),
-                                            ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))],
-                                loc),
-                               s,
-                               strcat loc [sc "SELECT ",
-                                           strcatComma loc (map (fn (x, t) =>
-                                                                    strcat loc [
-                                                                    (L'.EField (gf "SelectExps", x), loc),
-                                                                    sc (" AS _" ^ x)
+                    let
+                        val sexps = ListMergeSort.sort
+                                        (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps
+                    in
+                        ((L'.EAbs ("r",
+                                   (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)),
+                                                ("Where", s),
+                                                ("GroupBy", un),
+                                                ("Having", s),
+                                                ("SelectFields", un),
+                                                ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))],
+                                    loc),
+                                   s,
+                                   strcat loc [sc "SELECT ",
+                                               strcatComma loc (map (fn (x, t) =>
+                                                                        strcat loc [
+                                                                        (L'.EField (gf "SelectExps", x), loc),
+                                                                        sc (" AS _" ^ x)
                                                                     ]) sexps
-                                                            @ map (fn (x, xts) =>
-                                                                      strcatComma loc
-                                                                                  (map (fn (x', _) =>
-                                                                                           sc (x ^ ".uw_" ^ x'))
-                                                                                       xts)) stables),
-                                           sc " FROM ",
-                                           strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc),
-                                                                                          sc (" AS " ^ x)]) tables),
-                                           (L'.ECase (gf "Where",
-                                                      [((L'.PPrim (Prim.String "TRUE"), loc),
-                                                        sc ""),
-                                                       ((L'.PWild, loc),
-                                                        strcat loc [sc " WHERE ", gf "Where"])],
-                                                      {disc = s,
-                                                       result = s}), loc),
-                                                        
-                                           if List.all (fn (x, xts) =>
-                                                           case List.find (fn (x', _) => x' = x) grouped of
-                                                               NONE => List.null xts
-                                                             | SOME (_, xts') =>
-                                                               List.all (fn (x, _) =>
-                                                                            List.exists (fn (x', _) => x' = x)
-                                                                                        xts') xts) tables then
-                                               sc ""
-                                           else
-                                               strcat loc [
-                                               sc " GROUP BY ",
-                                               strcatComma loc (map (fn (x, xts) =>
-                                                                        strcatComma loc
-                                                                                    (map (fn (x', _) =>
-                                                                                             sc (x ^ ".uw_" ^ x'))
-                                                                                         xts)) grouped)
-                                               ],
-
-                                           (L'.ECase (gf "Having",
-                                                      [((L'.PPrim (Prim.String "TRUE"), loc),
-                                                        sc ""),
-                                                       ((L'.PWild, loc),
-                                                        strcat loc [sc " HAVING ", gf "Having"])],
-                                                      {disc = s,
-                                                       result = s}), loc)
-                              ]), loc),
-                     fm)
+                                                                @ map (fn (x, xts) =>
+                                                                          strcatComma loc
+                                                                                      (map (fn (x', _) =>
+                                                                                               sc (x ^ ".uw_" ^ x'))
+                                                                                           xts)) stables),
+                                               sc " FROM ",
+                                               strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc),
+                                                                                              sc (" AS " ^ x)]) tables),
+                                               (L'.ECase (gf "Where",
+                                                          [((L'.PPrim (Prim.String "TRUE"), loc),
+                                                            sc ""),
+                                                           ((L'.PWild, loc),
+                                                            strcat loc [sc " WHERE ", gf "Where"])],
+                                                          {disc = s,
+                                                           result = s}), loc),
+                                               
+                                               if List.all (fn (x, xts) =>
+                                                               case List.find (fn (x', _) => x' = x) grouped of
+                                                                   NONE => List.null xts
+                                                                 | SOME (_, xts') =>
+                                                                   List.all (fn (x, _) =>
+                                                                                List.exists (fn (x', _) => x' = x)
+                                                                                            xts') xts) tables then
+                                                   sc ""
+                                               else
+                                                   strcat loc [
+                                                   sc " GROUP BY ",
+                                                   strcatComma loc (map (fn (x, xts) =>
+                                                                            strcatComma loc
+                                                                                        (map (fn (x', _) =>
+                                                                                                 sc (x ^ ".uw_" ^ x'))
+                                                                                             xts)) grouped)
+                                                   ],
+
+                                               (L'.ECase (gf "Having",
+                                                          [((L'.PPrim (Prim.String "TRUE"), loc),
+                                                            sc ""),
+                                                           ((L'.PWild, loc),
+                                                            strcat loc [sc " HAVING ", gf "Having"])],
+                                                          {disc = s,
+                                                           result = s}), loc)
+                                  ]), loc),
+                         fm)
+                    end
                   | _ => poly ()
             end
 
@@ -1498,6 +1505,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm)
           | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm)
 
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_nfunc"), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                fun sc s = (L'.EPrim (Prim.String s), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm)
+
           | L.EFfiApp ("Basis", "nextval", [e]) =>
             let
                 val un = (L'.TRecord [], loc)
diff --git a/src/urweb.grm b/src/urweb.grm
index 4f470fa0..3f56cb94 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -154,6 +154,13 @@ fun sql_relop (oper, sqlexp1, sqlexp2, loc) =
         (EApp (e, sqlexp2), loc)
     end
 
+fun sql_nfunc (oper, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_nfunc", Infer), loc)
+    in
+        (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
+    end
+
 fun native_unop (oper, e1, loc) =
     let
         val e = (EVar (["Basis"], oper, Infer), loc)
@@ -206,6 +213,7 @@ fun tagIn bt =
  | COUNT | AVG | SUM | MIN | MAX
  | ASC | DESC
  | INSERT | INTO | VALUES | UPDATE | SET | DELETE
+ | CURRENT_TIMESTAMP
  | NE | LT | LE | GT | GE
 
 %nonterm
@@ -1169,6 +1177,8 @@ sqlexp : TRUE                           (sql_inject (EVar (["Basis"], "True", In
                                                      s (FLOATleft, FLOATright)))
        | STRING                         (sql_inject (EPrim (Prim.String STRING),
                                                      s (STRINGleft, STRINGright)))
+       | CURRENT_TIMESTAMP              (sql_nfunc ("current_timestamp",
+                                                    s (CURRENT_TIMESTAMPleft, CURRENT_TIMESTAMPright)))
 
        | tident DOT fident              (let
                                              val loc = s (tidentleft, fidentright)
diff --git a/src/urweb.lex b/src/urweb.lex
index fd8a8077..fc8db17f 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -356,6 +356,8 @@ notags = [^<{\n]+;
 <INITIAL> "SET"       => (Tokens.SET (pos yypos, pos yypos + size yytext));
 <INITIAL> "DELETE"    => (Tokens.DELETE (pos yypos, pos yypos + size yytext));
 
+<INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
+
 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
 <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
 
diff --git a/tests/time.ur b/tests/time.ur
index f81c59c3..8676c48f 100644
--- a/tests/time.ur
+++ b/tests/time.ur
@@ -7,9 +7,9 @@ fun main () =
     dml (INSERT INTO t (Id, Time) VALUES (42, {now}));
     xml <- queryX (SELECT * FROM t)
            (fn r => <xml>{[r.T.Id]}: {[r.T.Time]}<br/></xml>);
-    minMax <- oneRow (SELECT MIN(t.Time) AS Min, MAX(t.Time) AS Max FROM t);
+    minMax <- oneRow (SELECT CURRENT_TIMESTAMP AS Cur, MIN(t.Time) AS Min, MAX(t.Time) AS Max FROM t);
     return <xml><body>
       {xml}
       {[now]}, {[now = now]}, {[now = later]}, {[later < now]}, {[now < later]}<br/>
-      {[minMax.Min]}, {[minMax.Max]}
+      {[minMax.Cur]}, {[minMax.Min]}, {[minMax.Max]}
     </body></xml>