Mercurial > urweb
changeset 1974:a10368c65e7f
Add day-of-week/month <-> int conversion functions.
author | Patrick Hurst <phurst@mit.edu> |
---|---|
date | Sat, 07 Dec 2013 21:31:51 -0500 |
parents | 155bd0bc4d28 |
children | 0ee44375fe64 |
files | lib/ur/datetime.ur lib/ur/datetime.urs |
diffstat | 2 files changed, 121 insertions(+), 25 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/datetime.ur Thu Dec 05 11:36:54 2013 -0500 +++ b/lib/ur/datetime.ur Sat Dec 07 21:31:51 2013 -0500 @@ -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;
--- a/lib/ur/datetime.urs Thu Dec 05 11:36:54 2013 -0500 +++ b/lib/ur/datetime.urs Sat Dec 07 21:31:51 2013 -0500 @@ -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