summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am13
-rw-r--r--include/urweb/urweb_cpp.h8
-rw-r--r--lib/ur/basis.urs10
-rw-r--r--lib/ur/datetime.ur144
-rw-r--r--lib/ur/datetime.urs38
-rw-r--r--src/c/urweb.c50
6 files changed, 256 insertions, 7 deletions
diff --git a/Makefile.am b/Makefile.am
index d626c267..652296ea 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -95,13 +95,12 @@ if USE_EMACS
endif
uninstall-local-main:
- rm -f $(DESTDIR)$(BIN)/urweb \
- $(DESTDIR)$(LIB_UR)/basis.urs $(DESTDIR)$(LIB_UR)/char.urs $(DESTDIR)$(LIB_UR)/listPair.urs $(DESTDIR)$(LIB_UR)/list.urs \
- $(DESTDIR)$(LIB_UR)/monad.urs $(DESTDIR)$(LIB_UR)/option.urs $(DESTDIR)$(LIB_UR)/string.urs $(DESTDIR)$(LIB_UR)/top.urs \
- $(DESTDIR)$(LIB_UR)/char.ur $(DESTDIR)$(LIB_UR)/listPair.ur $(DESTDIR)$(LIB_UR)/list.ur \
- $(DESTDIR)$(LIB_UR)/monad.ur $(DESTDIR)$(LIB_UR)/option.ur $(DESTDIR)$(LIB_UR)/string.ur $(DESTDIR)$(LIB_UR)/top.ur \
- $(DESTDIR)$(LIB_JS)/urweb.js \
- $(DESTDIR)$(INCLUDE)/config.h $(DESTDIR)$(INCLUDE)/queue.h $(DESTDIR)$(INCLUDE)/request.h $(DESTDIR)$(INCLUDE)/types.h \
+ rm -f $(DESTDIR)$(BIN)/urweb $(DESTDIR)$(LIB_UR)/basis.urs $(DESTDIR)$(LIB_UR)/char.urs $(DESTDIR)$(LIB_UR)/datetime.urs \
+ $(DESTDIR)$(LIB_UR)/listPair.urs \ $(DESTDIR)$(LIB_UR)/list.urs $(DESTDIR)$(LIB_UR)/monad.urs \
+ $(DESTDIR)$(LIB_UR)/option.urs $(DESTDIR)$(LIB_UR)/string.urs $(DESTDIR)$(LIB_UR)/top.urs $(DESTDIR)$(LIB_UR)/char.ur \
+ $(DESTDIR)$(LIB_UR)/datetime.ur $(DESTDIR)$(LIB_UR)/listPair.ur $(DESTDIR)$(LIB_UR)/list.ur $(DESTDIR)$(LIB_UR)/monad.ur \
+ $(DESTDIR)$(LIB_UR)/option.ur $(DESTDIR)$(LIB_UR)/string.ur $(DESTDIR)$(LIB_UR)/top.ur $(DESTDIR)$(LIB_JS)/urweb.js \
+ $(DESTDIR)$(INCLUDE)/config.h $(DESTDIR)$(INCLUDE)/queue.h $(DESTDIR)$(INCLUDE)/request.h $(DESTDIR)$(INCLUDE)/types.h \
$(DESTDIR)$(INCLUDE)/urweb.h $(DESTDIR)$(INCLUDE)/types_cpp.h $(DESTDIR)$(INCLUDE)/urweb_cpp.h
uninstall-local: uninstall-local-main uninstall-emacs
diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index 1943a9f9..1bb6b2f2 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -268,6 +268,14 @@ uw_Basis_int uw_Basis_diffInSeconds(struct uw_context *, uw_Basis_time, uw_Basis
uw_Basis_int uw_Basis_toSeconds(struct uw_context *, uw_Basis_time);
uw_Basis_int uw_Basis_diffInMilliseconds(struct uw_context *, uw_Basis_time, uw_Basis_time);
uw_Basis_int uw_Basis_toMilliseconds(struct uw_context *, uw_Basis_time);
+uw_Basis_time uw_Basis_fromDatetime(struct uw_context *, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int);
+uw_Basis_int uw_Basis_datetimeYear(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeMonth(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeDay(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeHour(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeMinute(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeSecond(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeDayOfWeek(struct uw_context *, uw_Basis_time);
extern const uw_Basis_time uw_Basis_minTime;
void uw_register_transactional(struct uw_context *, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free);
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index eefb5d2c..c94f2ba6 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -167,6 +167,16 @@ val diffInMilliseconds : time -> time -> int
val timef : string -> time -> string (* Uses strftime() format string *)
val readUtc : string -> option time
+(* Takes a year, month, day, hour, minute, second. *)
+val fromDatetime : int -> int -> int -> int -> int -> int -> time
+val datetimeYear : time -> int
+val datetimeMonth : time -> int
+val datetimeDay : time -> int
+val datetimeHour : time -> int
+val datetimeMinute: time -> int
+val datetimeSecond : time -> int
+val datetimeDayOfWeek : time -> int
+
(** * Encryption *)
diff --git a/lib/ur/datetime.ur b/lib/ur/datetime.ur
new file mode 100644
index 00000000..676f141f
--- /dev/null
+++ b/lib/ur/datetime.ur
@@ -0,0 +1,144 @@
+datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday |
+ Friday | Saturday
+
+val show_day_of_week = mkShow (fn dow => case dow of
+ Sunday => "Sunday"
+ | Monday => "Monday"
+ | Tuesday => "Tuesday"
+ | Wednesday => "Wednesday"
+ | Thursday => "Thursday"
+ | Friday => "Friday"
+ | Saturday => "Saturday")
+
+fun dayOfWeekToInt dow = case dow of
+ Sunday => 0
+ | Monday => 1
+ | Tuesday => 2
+ | Wednesday => 3
+ | Thursday => 4
+ | Friday => 5
+ | Saturday => 6
+
+fun intToDayOfWeek i = case i of
+ 0 => Sunday
+ | 1 => Monday
+ | 2 => Tuesday
+ | 3 => Wednesday
+ | 4 => Thursday
+ | 5 => Friday
+ | 6 => Saturday
+ | n => error <xml>Invalid day of week {[n]}</xml>
+
+val eq_day_of_week = mkEq (fn a b => dayOfWeekToInt a = dayOfWeekToInt b)
+
+
+datatype month = January | February | March | April | May | June | July |
+ August | September | October | November | December
+
+val show_month = mkShow (fn m => case m of
+ January => "January"
+ | February => "February"
+ | March => "March"
+ | April => "April"
+ | May => "May"
+ | June => "June"
+ | July => "July"
+ | August => "August"
+ | September => "September"
+ | October => "October"
+ | November => "November"
+ | December => "December")
+
+type t = {
+ Year : int,
+ Month : month,
+ Day : int,
+ Hour : int,
+ Minute : int,
+ Second : int
+}
+
+fun monthToInt m = case m of
+ January => 0
+ | February => 1
+ | March => 2
+ | April => 3
+ | May => 4
+ | June => 5
+ | July => 6
+ | August => 7
+ | September => 8
+ | October => 9
+ | November => 10
+ | December => 11
+
+fun intToMonth i = case i of
+ 0 => January
+ | 1 => February
+ | 2 => March
+ | 3 => April
+ | 4 => May
+ | 5 => June
+ | 6 => July
+ | 7 => August
+ | 8 => September
+ | 9 => October
+ | 10 => November
+ | 11 => December
+ | n => error <xml>Invalid month number {[n]}</xml>
+
+val eq_month = mkEq (fn a b => monthToInt a = monthToInt b)
+
+
+fun toTime dt : time = fromDatetime dt.Year (monthToInt dt.Month) dt.Day
+ dt.Hour dt.Minute dt.Second
+
+fun fromTime t : t = {
+ Year = datetimeYear t,
+ Month = intToMonth (datetimeMonth t),
+ Day = datetimeDay t,
+ Hour = datetimeHour t,
+ Minute = datetimeMinute t,
+ Second = datetimeSecond t
+}
+
+val ord_datetime = mkOrd { Lt = fn a b => toTime a < toTime b,
+ Le = fn a b => toTime a <= toTime b }
+
+fun format fmt dt : string = timef fmt (toTime dt)
+
+fun dayOfWeek dt : day_of_week =
+ case datetimeDayOfWeek (toTime dt) of
+ 0 => Sunday
+ | 1 => Monday
+ | 2 => Tuesday
+ | 3 => Wednesday
+ | 4 => Thursday
+ | 5 => Friday
+ | 6 => Saturday
+ | n => error <xml>Illegal day of week {[n]}</xml>
+
+val now : transaction t =
+ n <- now;
+ return (fromTime n)
+
+(* Normalize a datetime. This will convert, e.g., January 32nd into February
+ 1st. *)
+
+fun normalize dt = fromTime (toTime dt)
+fun addToField [nm :: Name] [rest ::: {Type}] [[nm] ~ rest]
+ (delta : int) (r : $([nm = int] ++ rest))
+ : $([nm = int] ++ rest) =
+ (r -- nm) ++ {nm = r.nm + delta}
+
+
+(* Functions for adding to a datetime. There is no addMonths or addYears since
+ it's not clear what should be done; what's 1 month after January 31, or 1
+ year after February 29th?
+
+ These can't all be defined in terms of addSeconds because of leap seconds. *)
+
+fun addSeconds n dt = normalize (addToField [#Second] n dt)
+fun addMinutes n dt = normalize (addToField [#Minute] n dt)
+fun addHours n dt = normalize (addToField [#Hour] n dt)
+fun addDays n dt = normalize (addToField [#Day] n dt)
diff --git a/lib/ur/datetime.urs b/lib/ur/datetime.urs
new file mode 100644
index 00000000..972f86bf
--- /dev/null
+++ b/lib/ur/datetime.urs
@@ -0,0 +1,38 @@
+datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday |
+ Friday | Saturday
+
+datatype month = January | February | March | April | May | June | July |
+ August | September | October | November | December
+
+
+type t = {
+ Year : int,
+ Month : month,
+ Day : int,
+ Hour : int,
+ Minute : int,
+ Second : int
+}
+
+val ord_datetime : ord t
+
+val show_day_of_week : show day_of_week
+val show_month : show month
+val eq_day_of_week : eq day_of_week
+val eq_month : eq month
+val dayOfWeekToInt : day_of_week -> int
+val intToDayOfWeek : int -> day_of_week
+val monthToInt : month -> int
+val intToMonth : int -> month
+
+val toTime : t -> time
+val fromTime : time -> t
+val format : string -> t -> string
+val dayOfWeek : t -> day_of_week
+val now : transaction t
+val normalize : t -> t
+
+val addSeconds : int -> t -> t
+val addMinutes : int -> t -> t
+val addHours : int -> t -> t
+val addDays : int -> t -> t
diff --git a/src/c/urweb.c b/src/c/urweb.c
index c0c339c1..d7761f7a 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3930,6 +3930,56 @@ uw_Basis_int uw_Basis_toSeconds(uw_context ctx, uw_Basis_time tm) {
return tm.seconds;
}
+uw_Basis_time uw_Basis_fromDatetime(uw_context ctx, uw_Basis_int year, uw_Basis_int month, uw_Basis_int day, uw_Basis_int hour, uw_Basis_int minute, uw_Basis_int second) {
+ struct tm tm = { .tm_year = year - 1900, .tm_mon = month, .tm_mday = day,
+ .tm_hour = hour, .tm_min = minute, .tm_sec = second };
+ uw_Basis_time r = { timegm(&tm) };
+ return r;
+}
+
+uw_Basis_int uw_Basis_datetimeYear(uw_context ctx, uw_Basis_time time) {
+ struct tm tm;
+ gmtime_r(&time.seconds, &tm);
+ return tm.tm_year + 1900;
+}
+
+uw_Basis_int uw_Basis_datetimeMonth(uw_context ctx, uw_Basis_time time) {
+ struct tm tm;
+ gmtime_r(&time.seconds, &tm);
+ return tm.tm_mon;
+}
+
+uw_Basis_int uw_Basis_datetimeDay(uw_context ctx, uw_Basis_time time) {
+ struct tm tm;
+ gmtime_r(&time.seconds, &tm);
+ return tm.tm_mday;
+}
+
+uw_Basis_int uw_Basis_datetimeHour(uw_context ctx, uw_Basis_time time) {
+ struct tm tm;
+ gmtime_r(&time.seconds, &tm);
+ return tm.tm_hour;
+}
+
+uw_Basis_int uw_Basis_datetimeMinute(uw_context ctx, uw_Basis_time time) {
+ struct tm tm;
+ gmtime_r(&time.seconds, &tm);
+ return tm.tm_min;
+}
+
+uw_Basis_int uw_Basis_datetimeSecond(uw_context ctx, uw_Basis_time time) {
+ struct tm tm;
+ gmtime_r(&time.seconds, &tm);
+ return tm.tm_sec;
+}
+
+uw_Basis_int uw_Basis_datetimeDayOfWeek(uw_context ctx, uw_Basis_time time) {
+ struct tm tm;
+ gmtime_r(&time.seconds, &tm);
+ return tm.tm_wday;
+}
+
+
void *uw_get_global(uw_context ctx, char *name) {
int i;
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-31 15:09:35 +0000