Mercurial > urweb

comparison lib/ur/datetime.ur @ 1974:a10368c65e7f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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)