Add day-of-week/month <-> int conversion functions.

2 files changed, 121 insertions, 25 deletions

diff --git a/lib/ur/datetime.ur b/lib/ur/datetime.ur
index a633dc83..6d995d89 100644
--- a/lib/ur/datetime.ur
+++ b/lib/ur/datetime.ur
@@ -1,37 +1,120 @@
-type datetime = {
+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 : int,
+     Month : month,
      Day : int,
      Hour : int,
      Minute : int,
      Second : int
 }
 
-datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday |
-         Friday | Saturday
+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
 
-val show = mkShow (fn dow => case dow of
-                                 Sunday => "Sunday"
-                               | Monday => "Monday"
-                               | Tuesday => "Tuesday"
-                               | Wednesday => "Wednesday"
-                               | Thursday => "Thursday"
-                               | Friday => "Friday"
-                               | Saturday => "Saturday")
+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>
 
-fun toTime dt : time = fromDatetime dt.Year dt.Month dt.Day
+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 : datetime = {
     Year = datetimeYear t,
-    Month = datetimeMonth t,
+    Month = intToMonth (datetimeMonth t),
     Day = datetimeDay t,
     Hour = datetimeHour t,
     Minute = datetimeMinute t,
     Second = datetimeSecond t
 }
 
-fun datetimef fmt dt : string = timef fmt (toTime dt)
+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 datetime =
     n <- now;
diff --git a/lib/ur/datetime.urs b/lib/ur/datetime.urs
index 0d8e8c28..2fc2998b 100644
--- a/lib/ur/datetime.urs
+++ b/lib/ur/datetime.urs
@@ -1,17 +1,30 @@
-type datetime = { Year : int,
-                  Month : int,
-                  Day : int,
-                  Hour : int,
-                  Minute : int,
-                  Second : int
-                }
-
 datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday |
          Friday | Saturday
 
-val show : show day_of_week
+datatype month = January | February | March | April | May | June | July |
+         August | September | October | November | December
+
+
+type datetime = {
+     Year : int,
+     Month : month,
+     Day : int,
+     Hour : int,
+     Minute : int,
+     Second : int
+}
+
+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 : datetime -> time
 val fromTime : time -> datetime
-val datetimef : string -> datetime -> string
+val format : string -> datetime -> string
+val dayOfWeek : datetime -> day_of_week
 val now : transaction datetime