# HG changeset patch # User Patrick Hurst # Date 1386469911 18000 # Node ID a10368c65e7fae59c3d0ef3344897ef120d4426d # Parent 155bd0bc4d287da46d240e86edc3bd97f864e9e9 Add day-of-week/month <-> int conversion functions. diff -r 155bd0bc4d28 -r a10368c65e7f lib/ur/datetime.ur --- 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 Invalid day of week {[n]} + +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 Invalid month number {[n]} -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 Illegal day of week {[n]} + val now : transaction datetime = n <- now; diff -r 155bd0bc4d28 -r a10368c65e7f lib/ur/datetime.urs --- 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