Commit d96a5f6d authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Start implementing a real ISO 8601 parser

parent 147a2a88
;;; iso8601.el --- parse ISO 8601 date/time strings -*- lexical-binding:t -*-
;; Copyright (C) 2019 Free Software Foundation, Inc.
;; Keywords: dates
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(cl-defmethod make-decoded-time (&key second minute hour
day month year
dst zone)
(list (or second 0)
(or minute 0)
(or hour 0)
(or day 1)
(or month 1)
(or year 0)
nil
dst
zone))
(defun iso8601-parse-date (string)
"Parse STRING (which should be on ISO 8601 format) and return a time value."
(cond
;; Just a year: [-+]YYYY.
((string-match "\\`\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)\\'" string)
(let ((year (string-to-number (match-string 2 string)))
(sign (match-string 1 string)))
(make-decoded-time
:year (if (string= sign "-")
;; -0001 is 2 BCE.
(- year 1)
year))))
;; Calendar dates: YYY-MM-DD and variants.
((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)\\'"
string)
(make-decoded-time
:year (string-to-number (match-string 1 string))
:month (string-to-number (match-string 2 string))
:day (string-to-number (match-string 3 string))))
;; Calendar date without day: YYYY-MM.
((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)\\'" string)
(make-decoded-time
:year (string-to-number (match-string 1 string))
:month (string-to-number (match-string 2 string))))
;; Outdated date without year: --MM-DD
((string-match "\\`--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)\\'" string)
(make-decoded-time
:month (string-to-number (match-string 1 string))
:day (string-to-number (match-string 2 string))))
;; Week dates: YYYY-Www-D
((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?\\'"
string)
(let* ((year (string-to-number (match-string 1 string)))
(week (string-to-number (match-string 2 string)))
(day-of-week (and (match-string 3 string)
(string-to-number (match-string 3 string))))
(jan-start (decoded-time-weekday
(decode-time
(encode-time
(make-decoded-time :year year
:month 1
:day 4)))))
(correction (+ (if (zerop jan-start) 7 jan-start)
3))
(ordinal (+ (* week 7) (or day-of-week 0) (- correction))))
(cond
;; Monday 29 December 2008 is written "2009-W01-1".
((< ordinal 1)
(setq year (1- year)
ordinal (+ ordinal (iso8601-days-in-year year))))
;; Sunday 3 January 2010 is written "2009-W53-7".
((> ordinal (iso8601-days-in-year year))
(setq ordinal (- ordinal (iso8601-days-in-year year))
year (1+ year))))
(let ((month-day (iso8601-ordinal-to-date year ordinal)))
(make-decoded-time :year year
:month (car month-day)
:day (cdr month-day)))))
;; Ordinal dates: YYYY-DDD
((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9][0-9]\\)\\'"
string)
(let* ((year (string-to-number (match-string 1 string)))
(ordinal (string-to-number (match-string 2 string)))
(month-day (iso8601-ordinal-to-date year ordinal)))
(make-decoded-time :year year
:month (car month-day)
:day (cdr month-day))))))
(defun iso8601-parse-time (string)
"Parse STRING, which should be an ISO 8601 time string, and return a time value."
(when (string-match "\\`\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?:?\\([0-9][0-9]\\)?\\.?\\([0-9][0-9][0-9]\\)?\\'"
string)
(let ((hour (string-to-number (match-string 1 string)))
(minute (and (match-string 2 string)
(string-to-number (match-string 2 string))))
(second (and (match-string 3 string)
(string-to-number (match-string 3 string))))
;; Hm...
(_millisecond (and (match-string 4 string)
(string-to-number (match-string 4 string)))))
(make-decoded-time :hour hour
:minute (or minute 0)
:second (or second 0)))))
(defun iso8601-parse-zone (string)
"Parse STRING, which should be an ISO 8601 time zone.
Return the number of minutes."
(when (string-match "\\`\\(Z\\|\\([-+]\\)?\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)\\'"
string)
(if (match-string 1 string)
;; HH:MM-ish.
(let ((hour (string-to-number (match-string 3 string)))
(minute (and (match-string 4 string)
(string-to-number (match-string 5 string)))))
(+ (* (if (equal (match-string 1 string) "-")
(- hour)
hour)
60
(or minute 0))))
;; "Z".
0)))
(defun iso8601-parse (string)
"Parse a time string."
(when (string-match "\\`\\([^T]+\\)\\(T\\([:0-9]+\\)\\(.+\\)?\\)?\\'" string)
(let* ((date-string (match-string 1 string))
(time-string (match-string 3 string))
(zone-string (match-string 4 string))
(date (iso8601-parse-date date-string)))
(when time-string
(let ((time (iso8601-parse-time time-string)))
(setf (decoded-time-hour date) (decoded-time-hour time))
(setf (decoded-time-minute date) (decoded-time-minute time))
(setf (decoded-time-second date) (decoded-time-second time))))
(when zone-string
(setf (decoded-time-zone date)
;; The time zone in decoded times are in seconds.
(* (iso8601-parse-zone zone-string) 60)))
date)))
(defun iso8601-days-in-year (year)
(if (and (zerop (% year 4))
(if (zerop (% year 100))
(not (zerop (% year 400)))
t))
366
365))
(defun iso8601-days-in-month (year month)
(if (= month 2)
(if (= (iso8601-days-in-year year) 365)
28
29)
(if (memq month '(1 3 5 7 8 10 12))
31
30)))
(defun iso8601-ordinal-to-date (year ordinal)
(let ((month 1))
(while (> ordinal (iso8601-days-in-month year month))
(setq ordinal (- ordinal (iso8601-days-in-month year month))
month (1+ month)))
(cons month ordinal)))
(defun iso8601-parse-duration (string)
"Parse ISO 8601 durations on the form P3Y6M4DT12H30M5S."
(cond
((string-match "\\`P\\([0-9]+Y\\)?\\([0-9]+M\\)?\\([0-9]+D\\)?\\(T\\([0-9]+H\\)?\\([0-9]+M\\)?\\([0-9]+S\\)?\\)?\\'"
string)
(let ((year (match-string 1 string))
(month (match-string 2 string))
(day (match-string 3 string))
(hour (match-string 5 string))
(minute (match-string 6 string))
(second (match-string 7 string)))
(when (> (length (match-string 0 string)) 2)
(make-decoded-time :year (if year (string-to-number year) 0)
:month (if month (string-to-number month) 0)
:day (if day (string-to-number day) 0)
:hour (if hour (string-to-number hour) 0)
:minute (if minute (string-to-number minute) 0)
:second (if second (string-to-number second) 0)))))
;; PnW: Weeks.
((string-match "\\`P\\([0-9]+\\)W\\'" string)
(let ((weeks (string-to-number (match-string 1 string))))
;; Does this make sense? Hm...
(make-decoded-time :day (* weeks 7))))
;; P<date>T<time>
((string-match "\\`P[-0-9W]+T[:0-9]+\\'" string)
(iso8601-parse (substring string 1)))))
(defun iso8601-parse-interval (string)
"Parse ISO 8601 intervals."
(let ((bits (split-string string "/"))
start end duration)
(when (= (length bits) 2)
(cond
((string-match "\\`P" (car bits))
(setq duration (iso8601-parse-duration (car bits))
end (encode-time (iso8601-parse (cadr bits)))
start (time-subtract end (encode-time duration))))
((string-match "\\`P" (cadr bits))
(setq duration (iso8601-parse-duration (cadr bits))
start (encode-time (iso8601-parse (car bits)))
end (time-add start (encode-time duration))))
(t
(setq start (encode-time (iso8601-parse (car bits)))
end (encode-time (iso8601-parse (cadr bits)))))))
(list start end)))
(provide 'iso8601)
;;; iso8601.el ends here
......@@ -9054,6 +9054,82 @@ to capitalize ARG words."
(capitalize-region (region-beginning) (region-end))
(capitalize-word arg)))
;;; Accessors for `decode-time' values.
(defsubst decoded-time-second (time)
"The seconds in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 60 (inclusive). (60 is a leap
second, which only some operating systems support.)"
(nth 0 time))
(defsubst decoded-time-minute (time)
"The minutes in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 59 (inclusive)."
(nth 1 time))
(defsubst decoded-time-hour (time)
"The hours in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 23 (inclusive)."
(nth 2 time))
(defsubst decoded-time-day (time)
"The day-of-the-month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 31 (inclusive)."
(nth 3 time))
(defsubst decoded-time-month (time)
"The month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 12 (inclusive). January is 1."
(nth 4 time))
(defsubst decoded-time-year (time)
"The year in TIME, which is a value returned by `decode-time'.
This is a four digit integer."
(nth 5 time))
(defsubst decoded-time-weekday (time)
"The day-of-the-week in TIME, which is a value returned by `decode-time'.
This is a number between 0 and 6, and 0 is Sunday."
(nth 6 time))
(defsubst decoded-time-dst (time)
"The daylight saving time in TIME, which is a value returned by `decode-time'.
This is t if daylight saving time is in effect, and nil if not."
(nth 7 time))
(defsubst decoded-time-zone (time)
"The time zone in TIME, which is a value returned by `decode-time'.
This is an integer indicating the UTC offset in seconds, i.e.,
the number of seconds east of Greenwich."
(nth 8 time))
(gv-define-setter decoded-time-second (second time)
`(setf (nth 0 ,time) ,second))
(gv-define-setter decoded-time-minute (minute time)
`(setf (nth 1 ,time) ,minute))
(gv-define-setter decoded-time-hour (hour time)
`(setf (nth 2 ,time) ,hour))
(gv-define-setter decoded-time-day (day time)
`(setf (nth 3 ,time) ,day))
(gv-define-setter decoded-time-month (month time)
`(setf (nth 4 ,time) ,month))
(gv-define-setter decoded-time-year (year time)
`(setf (nth 5 ,time) ,year))
;; No setter for weekday, which is the 6th element.
(gv-define-setter decoded-time-dst (dst time)
`(setf (nth 7 ,time) ,dst))
(gv-define-setter decoded-time-zone (zone time)
`(setf (nth 8 ,time) ,zone))
(provide 'simple)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment