Mercurial > urweb

changeset 436:024478c34f4d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
time type
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Oct 2008 14:36:48 -0400
parents f7b25375c0cf
children 1a4c1b5f4d8f
files include/types.h include/urweb.h lib/basis.urs src/c/urweb.c src/mono_opt.sml src/monoize.sml tests/time.ur tests/time.urp tests/time.urs
diffstat 9 files changed, 114 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/include/types.h	Tue Oct 28 15:05:16 2008 -0400
+++ b/include/types.h	Thu Oct 30 14:36:48 2008 -0400
@@ -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 @@
 
 #define INTS_MAX 50
 #define FLOATS_MAX 100
+#define TIMES_MAX 100
--- a/include/urweb.h	Tue Oct 28 15:05:16 2008 -0400
+++ b/include/urweb.h	Thu Oct 30 14:36:48 2008 -0400
@@ -39,11 +39,13 @@
 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 @@
 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);
--- a/lib/basis.urs	Tue Oct 28 15:05:16 2008 -0400
+++ b/lib/basis.urs	Thu Oct 30 14:36:48 2008 -0400
@@ -1,6 +1,7 @@
 type int
 type float
 type string
+type time
 
 type unit = {}
 
@@ -52,6 +53,7 @@
 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_float : read float
 val read_string : read string
 val read_bool : read bool
+val read_time : read time
 
 
 (** SQL *)
--- a/src/c/urweb.c	Tue Oct 28 15:05:16 2008 -0400
+++ b/src/c/urweb.c	Thu Oct 30 14:36:48 2008 -0400
@@ -1,3 +1,5 @@
+#define _XOPEN_SOURCE
+
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
@@ -256,9 +258,9 @@
   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 @@
   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 @@
     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 @@
     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 @@
   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);
+}
--- a/src/mono_opt.sml	Tue Oct 28 15:05:16 2008 -0400
+++ b/src/mono_opt.sml	Thu Oct 30 14:36:48 2008 -0400
@@ -197,6 +197,13 @@
       | 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) =>
--- a/src/monoize.sml	Tue Oct 28 15:05:16 2008 -0400
+++ b/src/monoize.sml	Thu Oct 30 14:36:48 2008 -0400
@@ -820,6 +820,8 @@
             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 @@
                   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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/time.ur	Thu Oct 30 14:36:48 2008 -0400
@@ -0,0 +1,3 @@
+val now : time = readError "10/30/08 14:35:42"
+
+fun main () = return <xml>{[now]}</xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/time.urp	Thu Oct 30 14:36:48 2008 -0400
@@ -0,0 +1,3 @@
+debug
+
+time
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/time.urs	Thu Oct 30 14:36:48 2008 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page