summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorGravatar Patrick Hurst <phurst@mit.edu>2013-12-07 21:31:51 -0500
committerGravatar Patrick Hurst <phurst@mit.edu>2013-12-07 21:31:51 -0500
commitb2873bdd07801753460bd6f1b9efcc235a2f0268 (patch)
tree6ef28f7e1421a421f57f6aa2929bca0c11e4ecc7 /lib
parent90c266db553a99056e0baac98df05f06c34de4ae (diff)
Add day-of-week/month <-> int conversion functions.
Diffstat (limited to 'lib')
-rw-r--r--lib/ur/datetime.ur113
-rw-r--r--lib/ur/datetime.urs33
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