Mercurial > urweb
comparison lib/ur/datetime.ur @ 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 | 98bb0e952a11 |
comparison
equal
deleted
inserted
replaced
1973:155bd0bc4d28 | 1974:a10368c65e7f |
---|---|
1 type datetime = { | 1 datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday | |
2 Friday | Saturday | |
3 | |
4 val show_day_of_week = mkShow (fn dow => case dow of | |
5 Sunday => "Sunday" | |
6 | Monday => "Monday" | |
7 | Tuesday => "Tuesday" | |
8 | Wednesday => "Wednesday" | |
9 | Thursday => "Thursday" | |
10 | Friday => "Friday" | |
11 | Saturday => "Saturday") | |
12 | |
13 fun dayOfWeekToInt dow = case dow of | |
14 Sunday => 0 | |
15 | Monday => 1 | |
16 | Tuesday => 2 | |
17 | Wednesday => 3 | |
18 | Thursday => 4 | |
19 | Friday => 5 | |
20 | Saturday => 6 | |
21 | |
22 fun intToDayOfWeek i = case i of | |
23 0 => Sunday | |
24 | 1 => Monday | |
25 | 2 => Tuesday | |
26 | 3 => Wednesday | |
27 | 4 => Thursday | |
28 | 5 => Friday | |
29 | 6 => Saturday | |
30 | n => error <xml>Invalid day of week {[n]}</xml> | |
31 | |
32 val eq_day_of_week = mkEq (fn a b => dayOfWeekToInt a = dayOfWeekToInt b) | |
33 | |
34 | |
35 datatype month = January | February | March | April | May | June | July | | |
36 August | September | October | November | December | |
37 | |
38 val show_month = mkShow (fn m => case m of | |
39 January => "January" | |
40 | February => "February" | |
41 | March => "March" | |
42 | April => "April" | |
43 | May => "May" | |
44 | June => "June" | |
45 | July => "July" | |
46 | August => "August" | |
47 | September => "September" | |
48 | October => "October" | |
49 | November => "November" | |
50 | December => "December") | |
51 | |
52 type t = { | |
2 Year : int, | 53 Year : int, |
3 Month : int, | 54 Month : month, |
4 Day : int, | 55 Day : int, |
5 Hour : int, | 56 Hour : int, |
6 Minute : int, | 57 Minute : int, |
7 Second : int | 58 Second : int |
8 } | 59 } |
9 | 60 |
10 datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday | | 61 fun monthToInt m = case m of |
11 Friday | Saturday | 62 January => 0 |
63 | February => 1 | |
64 | March => 2 | |
65 | April => 3 | |
66 | May => 4 | |
67 | June => 5 | |
68 | July => 6 | |
69 | August => 7 | |
70 | September => 8 | |
71 | October => 9 | |
72 | November => 10 | |
73 | December => 11 | |
12 | 74 |
13 val show = mkShow (fn dow => case dow of | 75 fun intToMonth i = case i of |
14 Sunday => "Sunday" | 76 0 => January |
15 | Monday => "Monday" | 77 | 1 => February |
16 | Tuesday => "Tuesday" | 78 | 2 => March |
17 | Wednesday => "Wednesday" | 79 | 3 => April |
18 | Thursday => "Thursday" | 80 | 4 => May |
19 | Friday => "Friday" | 81 | 5 => June |
20 | Saturday => "Saturday") | 82 | 6 => July |
83 | 7 => August | |
84 | 8 => September | |
85 | 9 => October | |
86 | 10 => November | |
87 | 11 => December | |
88 | n => error <xml>Invalid month number {[n]}</xml> | |
21 | 89 |
22 fun toTime dt : time = fromDatetime dt.Year dt.Month dt.Day | 90 val eq_month = mkEq (fn a b => monthToInt a = monthToInt b) |
91 | |
92 | |
93 fun toTime dt : time = fromDatetime dt.Year (monthToInt dt.Month) dt.Day | |
23 dt.Hour dt.Minute dt.Second | 94 dt.Hour dt.Minute dt.Second |
24 | 95 |
25 fun fromTime t : datetime = { | 96 fun fromTime t : datetime = { |
26 Year = datetimeYear t, | 97 Year = datetimeYear t, |
27 Month = datetimeMonth t, | 98 Month = intToMonth (datetimeMonth t), |
28 Day = datetimeDay t, | 99 Day = datetimeDay t, |
29 Hour = datetimeHour t, | 100 Hour = datetimeHour t, |
30 Minute = datetimeMinute t, | 101 Minute = datetimeMinute t, |
31 Second = datetimeSecond t | 102 Second = datetimeSecond t |
32 } | 103 } |
33 | 104 |
34 fun datetimef fmt dt : string = timef fmt (toTime dt) | 105 fun format fmt dt : string = timef fmt (toTime dt) |
106 | |
107 fun dayOfWeek dt : day_of_week = | |
108 case datetimeDayOfWeek (toTime dt) of | |
109 0 => Sunday | |
110 | 1 => Monday | |
111 | 2 => Tuesday | |
112 | 3 => Wednesday | |
113 | 4 => Thursday | |
114 | 5 => Friday | |
115 | 6 => Saturday | |
116 | n => error <xml>Illegal day of week {[n]}</xml> | |
117 | |
35 | 118 |
36 val now : transaction datetime = | 119 val now : transaction datetime = |
37 n <- now; | 120 n <- now; |
38 return (fromTime n) | 121 return (fromTime n) |