summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/types.h4
-rw-r--r--include/urweb.h5
-rw-r--r--lib/basis.urs3
-rw-r--r--src/c/urweb.c79
-rw-r--r--src/mono_opt.sml7
-rw-r--r--src/monoize.sml11
-rw-r--r--tests/time.ur3
-rw-r--r--tests/time.urp3
-rw-r--r--tests/time.urs1
9 files changed, 114 insertions, 2 deletions
diff --git a/include/types.h b/include/types.h
index 09d88681..4e76243b 100644
--- a/include/types.h
+++ b/include/types.h
@@ -1,6 +1,9 @@
+#include <time.h>
+
typedef long long uw_Basis_int;
typedef double uw_Basis_float;
typedef char* uw_Basis_string;
+typedef time_t uw_Basis_time;
struct __uws_0 {
};
@@ -21,3 +24,4 @@ typedef enum { SUCCESS, FATAL, BOUNDED_RETRY, UNLIMITED_RETRY } failure_kind;
#define INTS_MAX 50
#define FLOATS_MAX 100
+#define TIMES_MAX 100
diff --git a/include/urweb.h b/include/urweb.h
index 6ac7df15..752c00d2 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -39,11 +39,13 @@ char *uw_Basis_htmlifyInt(uw_context, uw_Basis_int);
char *uw_Basis_htmlifyFloat(uw_context, uw_Basis_float);
char *uw_Basis_htmlifyString(uw_context, uw_Basis_string);
char *uw_Basis_htmlifyBool(uw_context, uw_Basis_bool);
+char *uw_Basis_htmlifyTime(uw_context, uw_Basis_time);
uw_unit uw_Basis_htmlifyInt_w(uw_context, uw_Basis_int);
uw_unit uw_Basis_htmlifyFloat_w(uw_context, uw_Basis_float);
uw_unit uw_Basis_htmlifyString_w(uw_context, uw_Basis_string);
uw_unit uw_Basis_htmlifyBool_w(uw_context, uw_Basis_bool);
+uw_unit uw_Basis_htmlifyTime_w(uw_context, uw_Basis_time);
char *uw_Basis_attrifyInt(uw_context, uw_Basis_int);
char *uw_Basis_attrifyFloat(uw_context, uw_Basis_float);
@@ -81,11 +83,14 @@ char *uw_Basis_ensqlBool(uw_Basis_bool);
uw_Basis_string uw_Basis_intToString(uw_context, uw_Basis_int);
uw_Basis_string uw_Basis_floatToString(uw_context, uw_Basis_float);
uw_Basis_string uw_Basis_boolToString(uw_context, uw_Basis_bool);
+uw_Basis_string uw_Basis_timeToString(uw_context, uw_Basis_time);
uw_Basis_int *uw_Basis_stringToInt(uw_context, uw_Basis_string);
uw_Basis_float *uw_Basis_stringToFloat(uw_context, uw_Basis_string);
uw_Basis_bool *uw_Basis_stringToBool(uw_context, uw_Basis_string);
+uw_Basis_time *uw_Basis_stringToTime(uw_context, uw_Basis_string);
uw_Basis_int uw_Basis_stringToInt_error(uw_context, uw_Basis_string);
uw_Basis_float uw_Basis_stringToFloat_error(uw_context, uw_Basis_string);
uw_Basis_bool uw_Basis_stringToBool_error(uw_context, uw_Basis_string);
+uw_Basis_time uw_Basis_stringToTime_error(uw_context, uw_Basis_string);
diff --git a/lib/basis.urs b/lib/basis.urs
index fce29ff9..ba8f3d40 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -1,6 +1,7 @@
type int
type float
type string
+type time
type unit = {}
@@ -52,6 +53,7 @@ val show_int : show int
val show_float : show float
val show_string : show string
val show_bool : show bool
+val show_time : show time
class read
val read : t ::: Type -> read t -> string -> option t
@@ -61,6 +63,7 @@ val read_int : read int
val read_float : read float
val read_string : read string
val read_bool : read bool
+val read_time : read time
(** SQL *)
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 3fa4d19d..7a160637 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1,3 +1,5 @@
+#define _XOPEN_SOURCE
+
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
@@ -256,9 +258,9 @@ void uw_memstats(uw_context ctx) {
printf("Heap: %d/%d\n", ctx->heap_front - ctx->heap, ctx->heap_back - ctx->heap);
}
-int uw_really_send(int sock, const void *buf, ssize_t len) {
+int uw_really_send(int sock, const void *buf, size_t len) {
while (len > 0) {
- ssize_t n = send(sock, buf, len, 0);
+ size_t n = send(sock, buf, len, 0);
if (n < 0)
return n;
@@ -725,6 +727,42 @@ uw_unit uw_Basis_htmlifyBool_w(uw_context ctx, uw_Basis_bool b) {
return uw_unit_v;
}
+#define TIME_FMT "%x %X"
+
+uw_Basis_string uw_Basis_htmlifyTime(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 "<i>Invalid time</i>";
+}
+
+uw_unit uw_Basis_htmlifyTime_w(uw_context ctx, uw_Basis_time t) {
+ size_t len;
+ char *r;
+ struct tm stm;
+
+ if (localtime_r(&t, &stm)) {
+ uw_check(ctx, TIMES_MAX);
+ r = ctx->page_front;
+ len = strftime(r, TIMES_MAX, TIME_FMT, &stm);
+ ctx->page_front += len;
+ } else {
+ uw_check(ctx, 20);
+ strcpy(ctx->page_front, "<i>Invalid time</i>");
+ ctx->page_front += 19;
+ }
+
+ return uw_unit_v;
+}
+
uw_Basis_string uw_Basis_strcat(uw_context ctx, uw_Basis_string s1, uw_Basis_string s2) {
int len = strlen(s1) + strlen(s2) + 1;
char *s;
@@ -860,6 +898,20 @@ uw_Basis_string uw_Basis_boolToString(uw_context ctx, uw_Basis_bool b) {
return "True";
}
+uw_Basis_string uw_Basis_timeToString(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>";
+}
uw_Basis_int *uw_Basis_stringToInt(uw_context ctx, uw_Basis_string s) {
char *endptr;
@@ -897,6 +949,19 @@ uw_Basis_bool *uw_Basis_stringToBool(uw_context ctx, uw_Basis_string s) {
return NULL;
}
+uw_Basis_time *uw_Basis_stringToTime(uw_context ctx, uw_Basis_string s) {
+ char *end = strchr(s, 0);
+ struct tm stm;
+
+ 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) {
char *endptr;
uw_Basis_int n = strtoll(s, &endptr, 10);
@@ -925,3 +990,13 @@ uw_Basis_bool uw_Basis_stringToBool_error(uw_context ctx, uw_Basis_string s) {
else
uw_error(ctx, FATAL, "Can't parse bool: %s", s);
}
+
+uw_Basis_time uw_Basis_stringToTime_error(uw_context ctx, uw_Basis_string s) {
+ char *end = strchr(s, 0);
+ struct tm stm = {};
+
+ 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/mono_opt.sml b/src/mono_opt.sml
index 843bdf90..8d11fe1a 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -197,6 +197,13 @@ fun exp e =
| EWrite (EFfiApp ("Basis", "htmlifyBool", [e]), _) =>
EFfiApp ("Basis", "htmlifyBool_w", [e])
+ | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "timeToString"), _), e), _)]) =>
+ EFfiApp ("Basis", "htmlifyTime", [e])
+ | EFfiApp ("Basis", "htmlifyString_w", [(EApp ((EFfi ("Basis", "timeToString"), _), e), _)]) =>
+ EFfiApp ("Basis", "htmlifyTime_w", [e])
+ | EWrite (EFfiApp ("Basis", "htmlifyTime", [e]), _) =>
+ EFfiApp ("Basis", "htmlifyTime_w", [e])
+
| EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]) =>
EPrim (Prim.String (htmlifyString s))
| EWrite (EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]), loc) =>
diff --git a/src/monoize.sml b/src/monoize.sml
index 5fda4fa1..273efafe 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -820,6 +820,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
end
| L.EFfi ("Basis", "show_bool") =>
((L'.EFfi ("Basis", "boolToString"), loc), fm)
+ | L.EFfi ("Basis", "show_time") =>
+ ((L'.EFfi ("Basis", "timeToString"), loc), fm)
| L.ECApp ((L.EFfi ("Basis", "read"), _), t) =>
let
@@ -873,6 +875,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
loc),
fm)
end
+ | L.EFfi ("Basis", "read_time") =>
+ let
+ val t = (L'.TFfi ("Basis", "time"), loc)
+ in
+ ((L'.ERecord [("Read", (L'.EFfi ("Basis", "stringToTime"), loc), readType' (t, loc)),
+ ("ReadError", (L'.EFfi ("Basis", "stringToTime_error"), loc), readErrType (t, loc))],
+ loc),
+ fm)
+ end
| L.ECApp ((L.EFfi ("Basis", "return"), _), t) =>
let
diff --git a/tests/time.ur b/tests/time.ur
new file mode 100644
index 00000000..393939e9
--- /dev/null
+++ b/tests/time.ur
@@ -0,0 +1,3 @@
+val now : time = readError "10/30/08 14:35:42"
+
+fun main () = return <xml>{[now]}</xml>
diff --git a/tests/time.urp b/tests/time.urp
new file mode 100644
index 00000000..f48698e9
--- /dev/null
+++ b/tests/time.urp
@@ -0,0 +1,3 @@
+debug
+
+time
diff --git a/tests/time.urs b/tests/time.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/time.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
generated by cgit v1.2.3 (git 2.39.1) at 2024-10-30 09:56:26 +0000