changeset 439:322c8620bbdf

Marshaling time to SQL
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Oct 2008 15:11:37 -0400
parents 1c27f03d9bd2
children 19d7f79cd584
files include/urweb.h src/c/urweb.c src/cjr_print.sml src/monoize.sml src/prepare.sml tests/time.ur
diffstat 6 files changed, 57 insertions(+), 15 deletions(-) [+]
line wrap: on
line diff
--- a/include/urweb.h	Thu Oct 30 14:57:15 2008 -0400
+++ b/include/urweb.h	Thu Oct 30 15:11:37 2008 -0400
@@ -77,6 +77,7 @@
 uw_Basis_string uw_Basis_sqlifyFloat(uw_context, uw_Basis_float);
 uw_Basis_string uw_Basis_sqlifyString(uw_context, uw_Basis_string);
 uw_Basis_string uw_Basis_sqlifyBool(uw_context, uw_Basis_bool);
+uw_Basis_string uw_Basis_sqlifyTime(uw_context, uw_Basis_time);
 
 char *uw_Basis_ensqlBool(uw_Basis_bool);
 
--- a/src/c/urweb.c	Thu Oct 30 14:57:15 2008 -0400
+++ b/src/c/urweb.c	Thu Oct 30 15:11:37 2008 -0400
@@ -860,6 +860,21 @@
     return "TRUE";
 }
 
+char *uw_Basis_sqlifyTime(uw_context ctx, uw_Basis_time t) {
+  size_t len;
+  char *r;
+  struct tm stm;
+
+  if (localtime_r(&t, &stm)) {
+    uw_check_heap(ctx, TIMES_MAX);
+    r = ctx->heap_front;
+    len = strftime(r, TIMES_MAX, TIME_FMT, &stm);
+    ctx->heap_front += len+1;
+    return r;
+  } else
+    return "<Invalid time>";
+}
+
 char *uw_Basis_ensqlBool(uw_Basis_bool b) {
   static uw_Basis_int true = 1;
   static uw_Basis_int false = 0;
@@ -954,13 +969,33 @@
   char *dot = strchr(s, '.'), *end = strchr(s, 0);
   struct tm stm;
 
-  if ((dot ? (*dot = 0, strptime(s, TIME_FMT_PG, &stm)) : strptime(s, TIME_FMT, &stm)) == end) {
-    uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
-    *r = mktime(&stm);
-    return r;    
+  if (dot) {
+    *dot = 0;
+    if (strptime(s, TIME_FMT_PG, &stm) == end) {
+      *dot = '.';
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      *r = mktime(&stm);
+      return r;
+    }
+    else {
+      *dot = '.';
+      return NULL;
+    }
   }
-  else
-    return NULL;
+  else {
+    if (strptime(s, TIME_FMT_PG, &stm) == end) {
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      *r = mktime(&stm);
+      return r;
+    }
+    else if (strptime(s, TIME_FMT, &stm) == end) {
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      *r = mktime(&stm);
+      return r;
+    }
+    else
+      return NULL;
+  }
 }
 
 uw_Basis_int uw_Basis_stringToInt_error(uw_context ctx, uw_Basis_string s) {
@@ -1008,7 +1043,9 @@
     }
   }
   else {
-    if (strptime(s, TIME_FMT, &stm) == end)
+    if (strptime(s, TIME_FMT_PG, &stm) == end)
+      return mktime(&stm);
+    else if (strptime(s, TIME_FMT, &stm) == end)
       return mktime(&stm);
     else
       uw_error(ctx, FATAL, "Can't parse time: %s", s);
--- a/src/cjr_print.sml	Thu Oct 30 14:57:15 2008 -0400
+++ b/src/cjr_print.sml	Thu Oct 30 15:11:37 2008 -0400
@@ -413,13 +413,15 @@
        | Float
        | String
        | Bool
+       | Time
 
 fun p_sql_type t =
     string (case t of
                 Int => "uw_Basis_int"
               | Float => "uw_Basis_float"
               | String => "uw_Basis_string"
-              | Bool => "uw_Basis_bool")
+              | Bool => "uw_Basis_bool"
+              | Time => "uw_Basis_time")
 
 fun getPargs (e, _) =
     case e of
@@ -430,6 +432,7 @@
       | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)]
       | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)]
       | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)]
+      | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)]
       | ECase (e, _, _) => [(e, Bool)]
 
       | _ => raise Fail "CjrPrint: getPargs"
@@ -440,13 +443,7 @@
       | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
       | String => e
       | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
-
-fun p_ensql_len t e =
-    case t of
-        Int => string "sizeof(uw_Basis_int)"
-      | Float => string "sizeof(uw_Basis_float)"
-      | String => box [string "strlen(", e, string ")"]
-      | Bool => string "sizeof(uw_Basis_bool)"
+      | Time => box [string "uw_Basis_sqlifyTime(ctx, ", e, string ")"]
 
 fun notLeaky env allowHeapAllocated =
     let
--- a/src/monoize.sml	Thu Oct 30 14:57:15 2008 -0400
+++ b/src/monoize.sml	Thu Oct 30 15:11:37 2008 -0400
@@ -1220,6 +1220,10 @@
             ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc),
                        (L'.EFfiApp ("Basis", "sqlifyString", [(L'.ERel 0, loc)]), loc)), loc),
              fm)
+          | L.EFfi ("Basis", "sql_time") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc),
+             fm)
 
           | L.ECApp ((L.EFfi ("Basis", "sql_subset"), _), _) =>
             ((L'.ERecord [], loc), fm)
--- a/src/prepare.sml	Thu Oct 30 14:57:15 2008 -0400
+++ b/src/prepare.sml	Thu Oct 30 15:11:37 2008 -0400
@@ -45,6 +45,8 @@
         SOME ("$" ^ Int.toString (n + 1) ^ "::text" :: ss, n + 1)
       | EFfiApp ("Basis", "sqlifyBool", [e]) =>
         SOME ("$" ^ Int.toString (n + 1) ^ "::bool" :: ss, n + 1)
+      | EFfiApp ("Basis", "sqlifyTime", [e]) =>
+        SOME ("$" ^ Int.toString (n + 1) ^ "::timestamp" :: ss, n + 1)
       | ECase (e,
                [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _),
                  (EPrim (Prim.String "TRUE"), _)),
--- a/tests/time.ur	Thu Oct 30 14:57:15 2008 -0400
+++ b/tests/time.ur	Thu Oct 30 15:11:37 2008 -0400
@@ -4,6 +4,7 @@
 val later : time = readError "10/30/08 14:37:42"
 
 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>);
     return <xml><body>