summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/urweb.h1
-rw-r--r--src/c/urweb.c51
-rw-r--r--src/cjr_print.sml13
-rw-r--r--src/monoize.sml4
-rw-r--r--src/prepare.sml2
-rw-r--r--tests/time.ur1
6 files changed, 57 insertions, 15 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 752c00d2..43a63324 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -77,6 +77,7 @@ uw_Basis_string uw_Basis_sqlifyInt(uw_context, uw_Basis_int);
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);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index df3ce6e1..f05b0b9d 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -860,6 +860,21 @@ char *uw_Basis_sqlifyBool(uw_context ctx, uw_Basis_bool b) {
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 @@ uw_Basis_time *uw_Basis_stringToTime(uw_context ctx, uw_Basis_string s) {
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 {
+ 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;
}
- else
- return NULL;
}
uw_Basis_int uw_Basis_stringToInt_error(uw_context ctx, uw_Basis_string s) {
@@ -1008,7 +1043,9 @@ uw_Basis_time uw_Basis_stringToTime_error(uw_context ctx, uw_Basis_string s) {
}
}
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);
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 01d71872..f1f4ef70 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -413,13 +413,15 @@ datatype sql_type =
| 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 @@ fun getPargs (e, _) =
| 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 @@ fun p_ensql t e =
| 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
diff --git a/src/monoize.sml b/src/monoize.sml
index 0557bb4c..d28b27e4 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1220,6 +1220,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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)
diff --git a/src/prepare.sml b/src/prepare.sml
index 6bf929f0..166f658b 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -45,6 +45,8 @@ fun prepString (e, ss, n) =
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"), _)),
diff --git a/tests/time.ur b/tests/time.ur
index f6093dd3..f66004a5 100644
--- a/tests/time.ur
+++ b/tests/time.ur
@@ -4,6 +4,7 @@ val now : time = readError "10/30/08 14:35:42"
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>
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 14:12:12 +0000