/
l0-time.lisp
223 lines (179 loc) · 8.46 KB
/
l0-time.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
(in-package #:metatilities)
(defconstant +minutes-per-hour+ 60
"The number of minutes in one hour.")
(defconstant +seconds-per-minute+ 60
"The number of seconds in one minute.")
(defconstant +usual-days-per-year+ 365
"The number of days in an ordinary year.")
(defconstant +seconds-per-hour+ (* +seconds-per-minute+ +minutes-per-hour+)
"The number of seconds in one hour.")
(defconstant +hours-per-day+ 24
"The number of hours in one day.")
(defconstant +seconds-per-day+
(* +hours-per-day+ +seconds-per-hour+)
"The number of seconds in one day.")
(defparameter +days-per-month+
'(31 28 31 30 31 30 31 31 30 31 30 31))
(eval-always
(defmacro generate-time-part-function (part-name position)
(let ((function-name (form-symbol (symbol-name 'time) "-" part-name)))
`(eval-always
(export ',function-name)
(defun ,function-name
(&optional (universal-time (get-universal-time))
(time-zone nil))
,(format nil "Returns the ~(~A~) part of the given time." part-name)
(nth-value ,position (apply #'decode-universal-time universal-time time-zone))))))
(generate-time-part-function second 0)
(generate-time-part-function minute 1)
(generate-time-part-function hour 2)
(generate-time-part-function date 3)
(generate-time-part-function month 4)
(generate-time-part-function year 5)
(generate-time-part-function day-of-week 6)
(generate-time-part-function daylight-savings-time-p 7))
(defun days-in-month (month &optional leap-year?)
"Returns the number of days in the specified month. The month should be
between 1 and 12."
(+ (nth (1- month) +days-per-month+) (if (and (= month 2) leap-year?) 1 0)))
(defun leap-year-p (year)
"Returns t if the specified year is a leap year. I.e. if the year
is divisible by four but not by 100 or if it is divisible by 400."
(or (and (= (mod year 4) 0) ; logand is faster but less perspicuous
(not (= (mod year 100) 0)))
(= (mod year 400) 0)))
(defun day-of-year (date &optional time-zone)
"Returns the day of the year [1 to 366] of the specified date [which must be \(CL\) universal time format.]"
(let ((leap-year? (leap-year-p (time-year date time-zone))))
(+ (loop for month from 1 to (1- (time-month date time-zone)) sum
(days-in-month month leap-year?))
(time-date date time-zone))))
(defun format-date (format date &optional stream (time-zone nil tz-supplied?))
"Formats universal dates using the same format specifiers as NSDateFormatter. The format is:
%% - A '%' character
%a - Abbreviated weekday name
%A - Full weekday name
%b - Abbreviated month name
%B - Full month name
%c - Shorthand for \"%X %x\", the locale format for date and time
%d - Day of the month as a decimal number [01-31]
%e - Same as %d but does not print the leading 0 for days 1 through 9
[unlike strftime[], does not print a leading space]
%F - Milliseconds as a decimal number [000-999]
%H - Hour based on a 24-hour clock as a decimal number [00-23]
%I - Hour based on a 12-hour clock as a decimal number [01-12]
%j - Day of the year as a decimal number [001-366]
%m - Month as a decimal number [01-12]
%M - Minute as a decimal number [00-59]
%p - AM/PM designation for the locale
%S - Second as a decimal number [00-59]
%w - Weekday as a decimal number [0-6], where Sunday is 0
%x - Date using the date representation for the locale, including
the time zone [produces different results from strftime[]]
%X - Time using the time representation for the locale [produces
different results from strftime[]]
%y - Year without century [00-99]
%Y - Year with century [such as 1990]
%Z - Time zone name [such as Pacific Daylight Time;
produces different results from strftime[]]
%z - Time zone offset in hours and minutes from GMT [HHMM]
None of %c, %F, %x, %X, %Z are implemented."
(let ((format-length (length format)))
(multiple-value-bind (sec min hr day mon yr dow dst tz)
(if tz-supplied?
(decode-universal-time date time-zone)
(decode-universal-time date))
(declare (ignore dst))
(format
stream "~{~A~}"
(loop for index = 0 then (1+ index)
while (< index format-length) collect
(let ((char (aref format index)))
(cond
((char= #\% char)
(setf char (aref format (incf index)))
(cond
;; %% - A '%' character
((char= char #\%) #\%)
;; %a - Abbreviated weekday name
((char= char #\a) (day->string dow :short))
;; %A - Full weekday name
((char= char #\A) (day->string dow :long))
;; %b - Abbreviated month name
((char= char #\b) (month->string mon :short))
;; %B - Full month name
((char= char #\B) (month->string mon :long))
;; %c - Shorthand for "%X, %x", the locale format for date and time
((char= char #\c) (nyi))
;; %d - Day of the month as a decimal number [01-31]
((char= char #\d) (format nil "~2,'0D" day))
;; %e - Same as %d but does not print the leading 0 for days 1 through 9
;; Unlike strftime, does not print a leading space
((char= char #\e) (format nil "~D" day))
;; %F - Milliseconds as a decimal number [000-999]
((char= char #\F) (nyi))
;; %H - Hour based on a 24-hour clock as a decimal number [00-23]
((char= char #\H) (format nil "~2,'0D" hr))
;; %I - Hour based on a 12-hour clock as a decimal number [01-12]
((char= char #\I) (format nil "~2,'0D" (1+ (mod (1- hr) 12))))
;; %j - Day of the year as a decimal number [001-366]
((char= char #\j) (format nil "~3,'0D" (day-of-year date time-zone)))
;; %m - Month as a decimal number [01-12]
((char= char #\m) (format nil "~2,'0D" mon))
;; %M - Minute as a decimal number [00-59]
((char= char #\M) (format nil "~2,'0D" min))
;; %p - AM/PM designation for the locale
((char= char #\p) (format nil "~:[PM~;AM~]" (< hr 12)))
;; %S - Second as a decimal number [00-59]
((char= char #\S) (format nil "~2,'0D" sec))
;; %w - Weekday as a decimal number [0-6], where Sunday is 0
((char= char #\w) (format nil "~D" dow))
;; %x - Date using the date representation for the locale,
;; including the time zone [produces different results from strftime]
((char= char #\x) (nyi))
;; %X - Time using the time representation for the locale
;; [produces different results from strftime]
((char= char #\X) (nyi))
;; %y - Year without century [00-99]
((char= char #\y)
(let ((year-string (format nil "~,2A" yr)))
(subseq year-string (- (length year-string) 2))))
;; %Y - Year with century [such as 1990]
((char= char #\Y) (format nil "~D" yr))
;; %Z - Time zone name (such as Pacific Daylight Time;
;; produces different results from strftime.
((char= char #\Z) (nyi))
;; %z - Time zone offset in hours and minutes from GMT [HHMM]
((char= char #\z)
(multiple-value-bind (tzint tzfrac)
(truncate tz)
(format nil "~:[+~;-~]~2,'0D~2,'0D"
(> tzint 0) (abs tzint) (* (abs tzfrac) 60))))
(t
(error "Ouch - unknown formatter '%~c" char))))
(t char))))))))
(defconstant +longer-format-index+ 0)
(defconstant +shorter-format-index+ 1)
(defparameter +month-output-list+
'(("January" "February" "March" "April" "May" "June" "July" "August" "September"
"October" "November" "December")
("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
(defparameter +dow-output-list
'(("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))
(defun day->string (day-of-the-week &optional (format :long))
"Returns the name of `day-of-the-week`. The parameter should be a number between 0 and 6 where 0 represents Sunday and 6 repressents Saturday. The optional format argument can be either :long or :short. In the latter case, the return string will be of length three; in the former it will be the complete name of the appropriate day."
(check-type day-of-the-week (mod 7))
(check-type format (member :long :short))
(nth day-of-the-week
(case format
(:long (nth +longer-format-index+ +dow-output-list))
(:short (nth +shorter-format-index+ +dow-output-list)))))
(defun month->string (month &optional (format :long))
"Returns the name \(in English\) of the month. Format can be :long or :short."
(check-type month (integer 1 12))
(check-type format (member :long :short))
(nth (1- month)
(case format
(:long (nth +longer-format-index+ +month-output-list+))
(:short (nth +shorter-format-index+ +month-output-list+)))))