From 78fa00e48ea6523631335c784ba78fbb350c1dee Mon Sep 17 00:00:00 2001 From: Lau Taarnskov Date: Fri, 13 Jul 2018 09:12:44 -0700 Subject: [PATCH 01/10] Add TimeZoneDatabase behaviour for time zone data. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: José Valim --- lib/elixir/lib/calendar/datetime.ex | 638 +++++++++++++++--- lib/elixir/lib/calendar/iso.ex | 1 + lib/elixir/lib/calendar/time_zone_database.ex | 198 ++++++ lib/elixir/test/elixir/calendar_test.exs | 296 ++++++++ .../calendar/fake_time_zone_database.exs | 258 +++++++ 5 files changed, 1303 insertions(+), 88 deletions(-) create mode 100644 lib/elixir/lib/calendar/time_zone_database.ex create mode 100644 lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index 58a1935de0d..43f1835cbd4 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -172,7 +172,9 @@ defmodule DateTime do Converts the given `NaiveDateTime` to `DateTime`. It expects a time zone to put the NaiveDateTime in. - Currently it only supports "Etc/UTC" as time zone. + + It only supports "Etc/UTC" as time zone if a `TimeZoneDatabase` + is not provided as a third argument. ## Examples @@ -180,12 +182,203 @@ defmodule DateTime do iex> datetime #DateTime<2016-05-24 13:26:08.003Z> + When the datetime is ambiguous - for instance during changing from summer + to winter time - the two possible valid datetimes are returned. First the one + that happens first, then the one that happens after. + + iex> {:ambiguous, first_dt, second_dt} = DateTime.from_naive(~N[2018-10-28 02:30:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + iex> first_dt + #DateTime<2018-10-28 02:30:00+02:00 CEST Europe/Copenhagen> + iex> second_dt + #DateTime<2018-10-28 02:30:00+01:00 CET Europe/Copenhagen> + + When there is a gap in wall time - for instance in spring when the clocks are + turned forward - the latest valid datetime just before the gap and the first + valid datetime just after the gap. + + iex> {:gap, just_before, just_after} = DateTime.from_naive(~N[2019-03-31 02:30:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + iex> just_before + #DateTime<2019-03-31 01:59:59.999999+01:00 CET Europe/Copenhagen> + iex> just_after + #DateTime<2019-03-31 03:00:00+02:00 CEST Europe/Copenhagen> + + Most of the time there is one, and just one, valid datetime for a certain + date and time in a certain time zone. + + iex> {:ok, datetime} = DateTime.from_naive(~N[2018-07-28 12:30:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + iex> datetime + #DateTime<2018-07-28 12:30:00+02:00 CEST Europe/Copenhagen> + """ @doc since: "1.4.0" - @spec from_naive(NaiveDateTime.t(), Calendar.time_zone()) :: {:ok, t} - def from_naive(naive_datetime, time_zone) + @spec from_naive( + NaiveDateTime.t(), + Calendar.time_zone(), + TimeZoneDatabaseClient.tz_db_or_config() + ) :: + {:ok, t} + | {:outside_leap_second_data_range, t} + | {:ambiguous, t, t} + | {:gap, t, t} + | {:error, :time_zone_not_found} + | {:error, :incompatible_calendars} + | {:error, :no_time_zone_database} + + def from_naive(naive_datetime, time_zone, tz_db_or_config \\ :from_config) + + def from_naive(%{second: 60} = naive_datetime, "Etc/UTC", tz_db_or_config) do + {:ok, dt} = do_from_naive(naive_datetime, "Etc/UTC", 0, 0, "UTC") + + case validate_positive_leap_second(dt, tz_db_or_config) do + :ok -> + {:ok, dt} + + {:error, :outside_leap_second_data_range} -> + {:outside_leap_second_data_range, dt} + + error -> + error + end + end + + def from_naive(naive_datetime, "Etc/UTC", _) do + do_from_naive(naive_datetime, "Etc/UTC", 0, 0, "UTC") + end + + def from_naive(%{calendar: Calendar.ISO} = naive_datetime, time_zone, tz_db_or_config) do + case TimeZoneDatabaseClient.time_zone_periods_from_wall_datetime( + naive_datetime, + time_zone, + tz_db_or_config + ) do + {:single, period} -> + do_from_naive_check_leap_second( + naive_datetime, + time_zone, + period.std_offset, + period.utc_offset, + period.zone_abbr, + tz_db_or_config + ) + + {:ambiguous, first_period, second_period} -> + {:ok, first_datetime} = + do_from_naive( + naive_datetime, + time_zone, + first_period.std_offset, + first_period.utc_offset, + first_period.zone_abbr + ) + + {:ok, second_datetime} = + do_from_naive( + naive_datetime, + time_zone, + second_period.std_offset, + second_period.utc_offset, + second_period.zone_abbr + ) + + {:ambiguous, first_datetime, second_datetime} + + {:gap, {first_period, first_period_until_wall}, {second_period, second_period_from_wall}} -> + # `until_wall` is not valid, but any time just before is. + # So by subtracting a second and adding .999999 seconds + # we get the last microsecond just before. + before_naive = + first_period_until_wall + |> Map.put(:microsecond, {999_999, 6}) + |> NaiveDateTime.add(-1) + + after_naive = second_period_from_wall + + {:ok, latest_datetime_before} = + do_from_naive( + before_naive, + time_zone, + first_period.std_offset, + first_period.utc_offset, + first_period.zone_abbr + ) + + {:ok, first_datetime_after} = + do_from_naive( + after_naive, + time_zone, + second_period.std_offset, + second_period.utc_offset, + second_period.zone_abbr + ) + + {:gap, latest_datetime_before, first_datetime_after} + + {:error, _} = error -> + error + end + end + + def from_naive(%{calendar: calendar} = naive_datetime, time_zone, tz_db_or_config) + when calendar != Calendar.ISO do + # For non-ISO calendars, convert to ISO, create ISO DateTime, and then + # convert to original calendar + iso_result = + with {:ok, in_iso} <- NaiveDateTime.convert(naive_datetime, Calendar.ISO) do + from_naive(in_iso, time_zone, tz_db_or_config) + end + + case iso_result do + {:ok, dt} -> + convert(dt, calendar) + + {:ambiguous, dt1, dt2} -> + with {:ok, dt1converted} <- convert(dt1, calendar), + {:ok, dt2converted} <- convert(dt2, calendar), + do: {:ambiguous, dt1converted, dt2converted} - def from_naive(%NaiveDateTime{} = naive_datetime, "Etc/UTC") do + {:gap, dt1, dt2} -> + with {:ok, dt1converted} <- convert(dt1, calendar), + {:ok, dt2converted} <- convert(dt2, calendar), + do: {:gap, dt1converted, dt2converted} + + {:error, _} = error -> + error + end + end + + # This assumes there are no time zones with offsets other than whole minutes during + # the period where leap seconds are in use. + defp do_from_naive_check_leap_second( + %{second: 60} = naive_datetime, + time_zone, + std_offset, + utc_offset, + zone_abbr, + tz_db_or_config + ) do + {:ok, datetime} = do_from_naive(naive_datetime, time_zone, std_offset, utc_offset, zone_abbr) + utc_dt = to_zero_total_offset(datetime) + + case TimeZoneDatabaseClient.is_leap_second(utc_dt, tz_db_or_config) do + {:ok, true} -> {:ok, datetime} + {:ok, false} -> {:error, :invalid_leap_second} + {:error, :outside_leap_second_data_range} -> {:outside_leap_second_data_range, datetime} + {:error, _} = error -> error + end + end + + defp do_from_naive_check_leap_second( + naive_datetime, + time_zone, + std_offset, + utc_offset, + zone_abbr, + _ + ) do + do_from_naive(naive_datetime, time_zone, std_offset, utc_offset, zone_abbr) + end + + defp do_from_naive(naive_datetime, time_zone, std_offset, utc_offset, zone_abbr) do %{ calendar: calendar, hour: hour, @@ -206,10 +399,10 @@ defmodule DateTime do minute: minute, second: second, microsecond: microsecond, - std_offset: 0, - utc_offset: 0, - zone_abbr: "UTC", - time_zone: "Etc/UTC" + std_offset: std_offset, + utc_offset: utc_offset, + zone_abbr: zone_abbr, + time_zone: time_zone } {:ok, datetime} @@ -219,18 +412,24 @@ defmodule DateTime do Converts the given `NaiveDateTime` to `DateTime`. It expects a time zone to put the NaiveDateTime in. - Currently it only supports "Etc/UTC" as time zone. ## Examples iex> DateTime.from_naive!(~N[2016-05-24 13:26:08.003], "Etc/UTC") #DateTime<2016-05-24 13:26:08.003Z> + iex> DateTime.from_naive!(~N[2018-05-24 13:26:08.003], "Europe/Copenhagen", FakeTimeZoneDatabase) + #DateTime<2018-05-24 13:26:08.003+02:00 CEST Europe/Copenhagen> + """ @doc since: "1.4.0" - @spec from_naive!(NaiveDateTime.t(), Calendar.time_zone()) :: t - def from_naive!(naive_datetime, time_zone) do - case from_naive(naive_datetime, time_zone) do + @spec from_naive!( + NaiveDateTime.t(), + Calendar.time_zone(), + TimeZoneDatabaseClient.tz_db_or_config() + ) :: t + def from_naive!(naive_datetime, time_zone, tz_db_or_config \\ :from_config) do + case from_naive(naive_datetime, time_zone, tz_db_or_config) do {:ok, datetime} -> datetime @@ -240,6 +439,170 @@ defmodule DateTime do end end + # Takes a datetime and in case it is is on the 61st second (60) it will check + # if it is a known leap second. All datetimes with non ISO calendars return :ok + @spec validate_positive_leap_second( + Calendar.datetime(), + TimeZoneDatabaseClient.tz_db_or_config() + ) :: :ok | {:error, atom} + defp validate_positive_leap_second(%{second: second, calendar: calendar}, _) + when second != 60 or calendar != Calendar.ISO do + :ok + end + + defp validate_positive_leap_second( + %{utc_offset: utc_offset, std_offset: std_offset} = dt, + tz_db_or_config + ) + when utc_offset + std_offset == 0 do + utc_dt = to_zero_total_offset(dt) + + case TimeZoneDatabaseClient.is_leap_second(utc_dt, tz_db_or_config) do + {:ok, true} -> + :ok + + {:ok, false} -> + {:error, :invalid_leap_second} + + {:error, _} = error -> + error + end + end + + @doc """ + Changes the time zone of a `DateTime`. + + Returns a `DateTime` for the same point in time, but instead at the time zone + provided. + + Requires passing a `TimeZoneDatabase` as an argument or setting it with + `TimeZoneDatabaseClient.set_database/1`. + + ## Examples + + iex> cph_datetime = DateTime.from_naive!(~N[2018-07-16 12:00:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + iex> {:ok, pacific_datetime} = DateTime.shift_zone(cph_datetime, "America/Los_Angeles", FakeTimeZoneDatabase) + iex> pacific_datetime + #DateTime<2018-07-16 03:00:00-07:00 PDT America/Los_Angeles> + + """ + @doc since: "1.8.0-dev" + @spec shift_zone(t, Calendar.time_zone(), TimeZoneDatabaseClient.tz_db_or_config()) :: + {:ok, t} | {:error, :time_zone_not_found} | {:error, atom} + def shift_zone(datetime, time_zone, tz_db_or_config \\ :from_config) + + def shift_zone(%{time_zone: time_zone} = datetime, time_zone, _) do + # When the desired time_zone is the same as the existing time_zone just return it unchanged. + {:ok, datetime} + end + + def shift_zone(%{second: 60, calendar: Calendar.ISO} = datetime, time_zone, tz_db_or_config) do + # If second is 60 (positive leap second) adjust it to 59, calculate, then adjust back to 60. + case shift_zone(%{datetime | second: 59}, time_zone, tz_db_or_config) do + {:ok, %{second: second} = dt_result} when second == 59 -> + {:ok, %{dt_result | second: 60}} + + {:ok, _} -> + {:error, :non_whole_minute_offsets_not_supported_for_leap_seconds} + + error -> + error + end + end + + def shift_zone( + %{ + calendar: Calendar.ISO, + std_offset: std_offset, + utc_offset: utc_offset, + microsecond: {_, microsecond_precision} + } = datetime, + time_zone, + tz_db_or_config + ) do + datetime_in_utc_iso_days = + datetime + |> to_iso_days() + |> apply_tz_offset(utc_offset + std_offset) + + case TimeZoneDatabaseClient.time_zone_period_from_utc_iso_days( + datetime_in_utc_iso_days, + time_zone, + tz_db_or_config + ) do + {:ok, period} -> + naive_datetime = + datetime_in_utc_iso_days + |> apply_tz_offset(-period.utc_offset - period.std_offset) + |> iso_days_to_iso_naive_datetime(microsecond_precision) + + do_from_naive( + naive_datetime, + time_zone, + period.std_offset, + period.utc_offset, + period.zone_abbr + ) + + {:error, _} = error -> + error + end + end + + def shift_zone(%{calendar: calendar} = datetime, time_zone, tz_db_or_config) + when calendar != Calendar.ISO do + with {:ok, iso_datetime} <- DateTime.convert(datetime, Calendar.ISO), + {:ok, shifted_zone_iso_dt} <- shift_zone(iso_datetime, time_zone, tz_db_or_config), + {:ok, shifted_zone_original_calendar_dt} <- convert(shifted_zone_iso_dt, calendar) do + {:ok, shifted_zone_original_calendar_dt} + end + end + + # Takes Calendar.naive_datetime and makes sure it has a zero total offset + @spec to_zero_total_offset(Calendar.naive_datetime()) :: Calendar.naive_datetime() + defp to_zero_total_offset(%{utc_offset: utc_offset, std_offset: std_offset} = datetime) + when utc_offset + std_offset == 0 do + # If the offset is already zero, return the datetime unchanged + datetime + end + + defp to_zero_total_offset(%{calendar: Calendar.ISO, second: 60} = datetime) do + datetime_with_second_59 = to_zero_total_offset(%{datetime | second: 59}) + %{datetime_with_second_59 | second: 60} + end + + defp to_zero_total_offset(%{calendar: Calendar.ISO} = datetime) do + datetime + |> NaiveDateTime.add(-1 * (datetime.utc_offset + datetime.std_offset)) + end + + @doc """ + Returns the current datetime in the provided time zone. + + Requires passing a `TimeZoneDatabase` as an argument or setting it with + `TimeZoneDatabaseClient.set_database/1`. + + ## Examples + + iex> {:ok, datetime} = DateTime.now("Europe/Copenhagen", FakeTimeZoneDatabase) + iex> datetime.time_zone + "Europe/Copenhagen" + iex> DateTime.now("not a real time zone name", FakeTimeZoneDatabase) + {:error, :time_zone_not_found} + + """ + @spec now(Calendar.time_zone(), TimeZoneDatabaseClient.tz_db_or_config()) :: + {:ok, t} | {:error, :time_zone_not_found} + def now(time_zone, tz_db_or_config \\ :from_config) + + def now("Etc/UTC", _) do + {:ok, utc_now()} + end + + def now(time_zone, tz_db_or_config) do + shift_zone(utc_now(), time_zone, tz_db_or_config) + end + @doc """ Converts the given `datetime` to Unix time. @@ -466,6 +829,11 @@ defmodule DateTime do Note that while ISO 8601 allows datetimes to specify 24:00:00 as the zero hour of the next day, this notation is not supported by Elixir. + Validates positive leap seconds (when the second is 60). When passed a + valid positive leap second, `{:error, :no_time_zone_database}` an error will + be returned unless a `TimeZoneDatabase` has been passed as the third argument + or set with `TimeZoneDatabaseClient.set_database/1`. + ## Examples iex> {:ok, datetime, 0} = DateTime.from_iso8601("2015-01-23T23:50:07Z") @@ -490,112 +858,189 @@ defmodule DateTime do iex> DateTime.from_iso8601("2015-01-23P23:50:07") {:error, :invalid_format} - iex> DateTime.from_iso8601("2015-01-23 23:50:07A") - {:error, :invalid_format} iex> DateTime.from_iso8601("2015-01-23T23:50:07") {:error, :missing_offset} iex> DateTime.from_iso8601("2015-01-23 23:50:61") {:error, :invalid_time} iex> DateTime.from_iso8601("2015-01-32 23:50:07") {:error, :invalid_date} - iex> DateTime.from_iso8601("2015-01-23T23:50:07.123-00:00") {:error, :invalid_format} - iex> DateTime.from_iso8601("2015-01-23T23:50:07.123-00:60") - {:error, :invalid_format} + + ## Examples with positive leap seconds + + iex> {:ok, datetime, 0} = DateTime.from_iso8601("2015-06-30 23:59:60Z", Calendar.ISO, FakeTimeZoneDatabase) + iex> datetime + #DateTime<2015-06-30 23:59:60Z> + + iex> DateTime.from_iso8601("2018-07-01 01:59:60+02:00", Calendar.ISO, FakeTimeZoneDatabase) + {:error, :invalid_leap_second} + iex> {:outside_leap_second_data_range, datetime, 7200} = DateTime.from_iso8601("2090-07-01 01:59:60+02:00", Calendar.ISO, FakeTimeZoneDatabase) + iex> datetime + #DateTime<2090-06-30 23:59:60Z> + + If a TimeZoneDatabase has not been set with + `TimeZoneDatabaseClient.set_database/1` and the second of the parsed datetime is 60: + + iex> DateTime.from_iso8601("2018-07-01 01:59:60+02:00") + {:error, :no_time_zone_database} """ @doc since: "1.4.0" - @spec from_iso8601(String.t(), Calendar.calendar()) :: - {:ok, t, Calendar.utc_offset()} | {:error, atom} - def from_iso8601(string, calendar \\ Calendar.ISO) - - def from_iso8601(<>, calendar) do - raw_from_iso8601(rest, calendar, true) + @spec from_iso8601(String.t(), Calendar.calendar(), TimeZoneDatabaseClient.tz_db_or_config()) :: + {:ok, t, Calendar.utc_offset()} + | {:outside_leap_second_data_range, t, Calendar.utc_offset()} + | {:error, atom} + def from_iso8601(string, calendar \\ Calendar.ISO, tz_db_or_config \\ :from_config) + + def from_iso8601(<>, calendar, tz_db_or_config) do + raw_from_iso8601(rest, calendar, tz_db_or_config, true) end - def from_iso8601(<>, calendar) do - raw_from_iso8601(rest, calendar, false) + def from_iso8601(<>, calendar, tz_db_or_config) do + raw_from_iso8601(rest, calendar, tz_db_or_config, false) end @sep [?\s, ?T] [match_date, guard_date, read_date] = Calendar.ISO.__match_date__() [match_time, guard_time, read_time] = Calendar.ISO.__match_time__() - defp raw_from_iso8601(string, calendar, is_negative_datetime) do + defp raw_from_iso8601(string, calendar, tz_db_or_config, is_year_negative) do with <> <- string, true <- unquote(guard_date) and sep in @sep and unquote(guard_time), {microsecond, rest} <- Calendar.ISO.parse_microsecond(rest), {offset, ""} <- Calendar.ISO.parse_offset(rest) do {year, month, day} = unquote(read_date) {hour, minute, second} = unquote(read_time) - year = if is_negative_datetime, do: -year, else: year - - cond do - not calendar.valid_date?(year, month, day) -> - {:error, :invalid_date} - - not calendar.valid_time?(hour, minute, second, microsecond) -> - {:error, :invalid_time} - - offset == 0 -> - datetime = %DateTime{ - calendar: calendar, - year: year, - month: month, - day: day, - hour: hour, - minute: minute, - second: second, - microsecond: microsecond, - std_offset: 0, - utc_offset: 0, - zone_abbr: "UTC", - time_zone: "Etc/UTC" - } - - {:ok, datetime, 0} - - is_nil(offset) -> - {:error, :missing_offset} - - true -> - day_fraction = Calendar.ISO.time_to_day_fraction(hour, minute, second, {0, 0}) - - {{year, month, day}, {hour, minute, second, _}} = - case apply_tz_offset({0, day_fraction}, offset) do - {0, day_fraction} -> - {{year, month, day}, Calendar.ISO.time_from_day_fraction(day_fraction)} - - {extra_days, day_fraction} -> - base_days = Calendar.ISO.date_to_iso_days(year, month, day) - - {Calendar.ISO.date_from_iso_days(base_days + extra_days), - Calendar.ISO.time_from_day_fraction(day_fraction)} - end - - datetime = %DateTime{ - calendar: calendar, - year: year, - month: month, - day: day, - hour: hour, - minute: minute, - second: second, - microsecond: microsecond, - std_offset: 0, - utc_offset: 0, - zone_abbr: "UTC", - time_zone: "Etc/UTC" - } - - {:ok, datetime, offset} - end + year = if is_year_negative, do: -year, else: year + + do_from_iso8601( + year, + month, + day, + hour, + minute, + second, + microsecond, + offset, + calendar, + tz_db_or_config + ) else _ -> {:error, :invalid_format} end end + defp do_from_iso8601( + year, + month, + day, + hour, + minute, + second, + microsecond, + offset, + calendar, + tz_db_or_config + ) do + cond do + not calendar.valid_date?(year, month, day) -> + {:error, :invalid_date} + + not calendar.valid_time?(hour, minute, second, microsecond) -> + {:error, :invalid_time} + + offset == 0 -> + datetime = %DateTime{ + calendar: calendar, + year: year, + month: month, + day: day, + hour: hour, + minute: minute, + second: second, + microsecond: microsecond, + std_offset: 0, + utc_offset: 0, + zone_abbr: "UTC", + time_zone: "Etc/UTC" + } + + case validate_positive_leap_second(datetime, tz_db_or_config) do + :ok -> + {:ok, datetime, 0} + + error -> + error + end + + is_nil(offset) -> + {:error, :missing_offset} + + second == 60 && calendar == Calendar.ISO -> + # Get the datetime as if the second is 59, then set the second back to 60 + # and check that it is a valid leap second. + with {:ok, datetime, offset} <- + do_from_iso8601( + year, + month, + day, + hour, + minute, + 59, + microsecond, + offset, + calendar, + tz_db_or_config + ) do + datetime = %{datetime | second: 60, microsecond: microsecond} + + case validate_positive_leap_second(datetime, tz_db_or_config) do + :ok -> + {:ok, datetime, offset} + + {:error, :outside_leap_second_data_range} -> + {:outside_leap_second_data_range, datetime, offset} + + error -> + error + end + end + + true -> + day_fraction = Calendar.ISO.time_to_day_fraction(hour, minute, second, {0, 0}) + + {{year, month, day}, {hour, minute, second, _}} = + case apply_tz_offset({0, day_fraction}, offset) do + {0, day_fraction} -> + {{year, month, day}, Calendar.ISO.time_from_day_fraction(day_fraction)} + + {extra_days, day_fraction} -> + base_days = Calendar.ISO.date_to_iso_days(year, month, day) + + {Calendar.ISO.date_from_iso_days(base_days + extra_days), + Calendar.ISO.time_from_day_fraction(day_fraction)} + end + + datetime = %DateTime{ + calendar: calendar, + year: year, + month: month, + day: day, + hour: hour, + minute: minute, + second: second, + microsecond: microsecond, + std_offset: 0, + utc_offset: 0, + zone_abbr: "UTC", + time_zone: "Etc/UTC" + } + + {:ok, datetime, offset} + end + end + @doc """ Converts the given `datetime` to a string according to its calendar. @@ -900,6 +1345,23 @@ defmodule DateTime do Calendar.ISO.add_day_fraction_to_iso_days(iso_days, -offset, 86400) end + @spec iso_days_to_iso_naive_datetime(Calendar.iso_days(), 0..6) :: NaiveDateTime.t() + defp iso_days_to_iso_naive_datetime(iso_days, microsecond_precision) do + {year, month, day, hour, minute, second, {microsecond_without_precision, _}} = + Calendar.ISO.naive_datetime_from_iso_days(iso_days) + + %NaiveDateTime{ + calendar: Calendar.ISO, + year: year, + month: month, + day: day, + hour: hour, + minute: minute, + second: second, + microsecond: {microsecond_without_precision, microsecond_precision} + } + end + defimpl String.Chars do def to_string(datetime) do %{ diff --git a/lib/elixir/lib/calendar/iso.ex b/lib/elixir/lib/calendar/iso.ex index e9f4127e36c..8c4e265a185 100644 --- a/lib/elixir/lib/calendar/iso.ex +++ b/lib/elixir/lib/calendar/iso.ex @@ -856,6 +856,7 @@ defmodule Calendar.ISO do {12, day_of_year - (334 + extra_day)} end + @spec iso_seconds_to_datetime(integer) :: :calendar.datetime() defp iso_seconds_to_datetime(seconds) do {days, rest_seconds} = div_mod(seconds, @seconds_per_day) diff --git a/lib/elixir/lib/calendar/time_zone_database.ex b/lib/elixir/lib/calendar/time_zone_database.ex new file mode 100644 index 00000000000..e82cb1bb4c1 --- /dev/null +++ b/lib/elixir/lib/calendar/time_zone_database.ex @@ -0,0 +1,198 @@ +defmodule TimeZoneDatabase do + @moduledoc """ + This module defines a behaviour for providing time zone data. + + IANA provides time zone data that includes data about different UTC offsets, + standard offsets for timezones as well as leap second data. + """ + + @typedoc """ + A period where a certain combination of UTC offset, standard offset and zone + abbreviation is in effect. + + For instance one period could be the summer of 2018 in "Europe/London" where summer time / + daylight saving time is in effect and lasts from spring to autumn. At autumn the `std_offset` + changes along with the `zone_abbr` so a different period is needed during winter. + """ + @type time_zone_period :: %{ + optional(any) => any, + utc_offset: Calendar.utc_offset(), + std_offset: Calendar.std_offset(), + zone_abbr: Calendar.zone_abbr() + } + + @typedoc """ + Limit for when a certain time zone period begins or ends. + + A beginning is inclusive. An ending is exclusive. Eg. if a period is from + 2015-03-29 01:00:00 and until 2015-10-25 01:00:00, the period includes and + begins from the begining of 2015-03-29 01:00:00 and lasts until just before + 2015-10-25 01:00:00. + + A beginning or end for certain periods are infinite. For instance the latest + period for time zones without DST or plans to change. However for the purpose + of this behaviour they are only used for gaps in wall time where the needed + period limits are at a certain time. + """ + @type time_zone_period_limit :: Calendar.naive_datetime() + + @doc """ + Time zone period for a point in time in UTC for a specific time zone. + + Takes a time zone name and a point in time for UTC and returns a + `time_zone_period` for that point in time. + """ + @callback time_zone_period_from_utc_iso_days(Calendar.iso_days(), Calendar.time_zone()) :: + {:ok, time_zone_period} | {:error, :time_zone_not_found} + + @doc """ + Possible time zone periods for a certain time zone and wall clock date and time. + + When the provided `datetime` is ambiguous a tuple with `:ambiguous` and two possible + periods. The periods in the list are sorted with the first element being the one that begins first. + + When the provided `datetime` is in a gap - for instance during the "spring forward" when going + from winter time to summer time, a tuple with `:gap` and two periods with limits are returned + in a nested tuple. The first nested two-tuple is the period before the gap and a naive datetime + with a limit for when the period ends (wall time). The second nested two-tuple is the period + just after the gap and a datetime (wall time) for when the period begins just after the gap. + + If there is only a single possible period for the provided `datetime`, the a tuple with `:single` + and the `time_zone_period` is returned. + """ + @callback time_zone_periods_from_wall_datetime(Calendar.naive_datetime(), Calendar.time_zone()) :: + {:single, time_zone_period} + | {:ambiguous, time_zone_period, time_zone_period} + | {:gap, {time_zone_period, time_zone_period_limit}, + {time_zone_period, time_zone_period_limit}} + | {:error, :time_zone_not_found} + + @doc """ + Determine if a datetime is a leap second or not. + + Takes a `Calendar.naive_datetime` and returns {:ok, true} if it is a + leap second. {:ok, false} if it is not. + + It cannot be predicted exactly when all leap seconds will be introduced in + the future. Every six months it is announced whether there will be a leap + second or not at the end of the coming June or December. If this function is + queried with a datetime that is so far into the future that it is has not + yet been announced if there will be a leap second or not + `{:error, :outside_leap_second_data_range}` should be returned. + """ + @callback is_leap_second(Calander.naive_datetime()) :: + {:ok, boolean} | {:error, :outside_leap_second_data_range} + + @doc """ + The difference in seconds between two datetimes. + + Takes two `Calendar.naive_datetime`s. They should represent UTC datetimes. + + Returns the difference in leap seconds between them. For instance when passed + `~N[2018-01-01 00:00:00]` and `~N[2014-01-01 00:00:00]` it should return `{:ok, 2}` + representing two leap seconds. + """ + @callback leap_second_diff(Calendar.naive_datetime(), Calendar.naive_datetime()) :: + {:ok, integer} + | {:error, :outside_leap_second_data_range} +end + +defmodule TimeZoneDatabaseClient do + @moduledoc """ + Module used by Elixir for getting time zone data from a `TimeZoneDatabase` client. + """ + + @typedoc """ + Returns either a `TimeZoneDatabase.t()` or a `:from_config` atom. + + This can be passed to functions in e.g. the `DateTime` module. If `:from_config` + is passed, a `TimeZoneDatabase` set via the `set_database/1` function is used. + """ + @type tz_db_or_config :: TimeZoneDatabase.t() | :from_config + + @doc """ + Function for setting a global time zone database. + + Takes a module that implements the TimeZoneDatabase behaviour. + """ + def set_database(time_zone_database) do + :elixir_config.put(:time_zone_database, time_zone_database) + end + + @doc false + @spec time_zone_periods_from_wall_datetime( + Calendar.naive_datetime(), + Calendar.time_zone(), + tz_db_or_config + ) :: + {:single, TimeZoneDatabase.time_zone_period()} + | {:ambiguous, TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period()} + | {:gap, + {TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period_limit()}, + {TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period_limit()}} + | {:error, :time_zone_not_found} + | {:error, :no_time_zone_database} + def time_zone_periods_from_wall_datetime( + %{calendar: Calendar.ISO} = naive_datetime, + time_zone, + tz_db_or_config + ) do + with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do + time_zone_database.time_zone_periods_from_wall_datetime(naive_datetime, time_zone) + end + end + + @doc false + @spec time_zone_period_from_utc_iso_days( + Calendar.iso_days(), + Calendar.time_zone(), + tz_db_or_config + ) :: + {:ok, TimeZoneDatabase.time_zone_period()} + | {:error, :time_zone_not_found} + | {:error, :no_time_zone_database} + def time_zone_period_from_utc_iso_days( + iso_days, + time_zone, + tz_db_or_config + ) do + with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do + time_zone_database.time_zone_period_from_utc_iso_days(iso_days, time_zone) + end + end + + @doc false + @spec is_leap_second(Calendar.naive_datetime(), tz_db_or_config) :: + {:ok, boolean} + | {:error, :outside_leap_second_data_range} + | {:error, :no_time_zone_database} + def is_leap_second(naive_datetime, tz_db_or_config) do + with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do + time_zone_database.is_leap_second(naive_datetime) + end + end + + @doc false + @spec leap_second_diff(Calendar.naive_datetime(), Calendar.naive_datetime(), tz_db_or_config) :: + {:ok, boolean} + | {:error, :no_time_zone_database} + | {:error, :outside_leap_second_data_range} + def leap_second_diff(datetime1, datetime2, tz_db_or_config) do + with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do + time_zone_database.leap_second_diff(datetime1, datetime2) + end + end + + @spec time_zone_database_from_tz_db_or_config(tz_db_or_config) :: + {:ok, TimeZoneDatabase.t()} | {:error, :no_time_zone_database} + defp time_zone_database_from_tz_db_or_config(:from_config) do + case :elixir_config.get(:time_zone_database, :no_time_zone_database) do + :no_time_zone_database -> {:error, :no_time_zone_database} + atom when is_atom(atom) -> {:ok, atom} + end + end + + defp time_zone_database_from_tz_db_or_config(time_zone_database) do + {:ok, time_zone_database} + end +end diff --git a/lib/elixir/test/elixir/calendar_test.exs b/lib/elixir/test/elixir/calendar_test.exs index 9d4cb37b26d..3d217f8d46c 100644 --- a/lib/elixir/test/elixir/calendar_test.exs +++ b/lib/elixir/test/elixir/calendar_test.exs @@ -1,5 +1,6 @@ Code.require_file("test_helper.exs", __DIR__) Code.require_file("fixtures/calendar/holocene.exs", __DIR__) +Code.require_file("fixtures/calendar/fake_time_zone_database.exs", __DIR__) defmodule FakeCalendar do def date_to_string(_, _, _), do: "boom" @@ -509,6 +510,37 @@ defmodule DateTimeTest do } end + test "from_iso8601 handles invalid date, time, formats correctly" do + assert DateTime.from_iso8601("2015-01-23T23:50:07") == {:error, :missing_offset} + assert DateTime.from_iso8601("2015-01-23 23:50:61") == {:error, :invalid_time} + assert DateTime.from_iso8601("2015-01-32 23:50:07") == {:error, :invalid_date} + assert DateTime.from_iso8601("2015-01-23 23:50:07A") == {:error, :invalid_format} + assert DateTime.from_iso8601("2015-01-23T23:50:07.123-00:60") == {:error, :invalid_format} + end + + test "from_iso8601 handles leap seconds correctly" do + assert DateTime.from_iso8601("2018-06-30 23:59:60Z", Calendar.ISO, FakeTimeZoneDatabase) == + {:error, :invalid_leap_second} + + {:ok, datetime, 0} = + DateTime.from_iso8601("2015-06-30 23:59:60Z", Calendar.ISO, FakeTimeZoneDatabase) + + assert datetime == %DateTime{ + calendar: Calendar.ISO, + day: 30, + hour: 23, + microsecond: {0, 0}, + minute: 59, + month: 6, + second: 60, + std_offset: 0, + time_zone: "Etc/UTC", + utc_offset: 0, + year: 2015, + zone_abbr: "UTC" + } + end + test "from_unix/2" do min_datetime = %DateTime{ calendar: Calendar.ISO, @@ -878,4 +910,268 @@ defmodule DateTimeTest do assert DateTime.diff(dt1, dt2) == 3_281_904_000 end + + test "from_naive" do + holocene_ndt = %NaiveDateTime{ + calendar: Calendar.Holocene, + year: 12018, + month: 7, + day: 1, + hour: 12, + minute: 34, + second: 25, + microsecond: {123_456, 6} + } + + assert DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) == + {:ok, + %DateTime{ + calendar: Calendar.Holocene, + day: 1, + hour: 12, + microsecond: {123_456, 6}, + minute: 34, + month: 7, + second: 25, + std_offset: 3600, + time_zone: "Europe/Copenhagen", + utc_offset: 3600, + year: 12018, + zone_abbr: "CEST" + }} + end + + test "from_naive with calendar not compatible with ISO" do + ndt = %{~N[2018-07-20 00:00:00] | calendar: FakeCalendar} + + assert DateTime.from_naive(ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) == + {:error, :incompatible_calendars} + end + + test "from_naive with valid positive leap second UTC" do + ndt = ~N[1982-06-30 23:59:60] + + {:ok, dt} = DateTime.from_naive(ndt, "Etc/UTC", FakeTimeZoneDatabase) + assert dt.second == 60 + assert dt.time_zone == "Etc/UTC" + end + + test "from_naive with possible but unknown future positive leap second UTC" do + ndt = ~N[2090-06-30 23:59:60] + + {:outside_leap_second_data_range, datetime} = + DateTime.from_naive(ndt, "Etc/UTC", FakeTimeZoneDatabase) + + assert datetime == %DateTime{ + calendar: Calendar.ISO, + day: 30, + hour: 23, + microsecond: {0, 0}, + minute: 59, + month: 6, + second: 60, + std_offset: 0, + time_zone: "Etc/UTC", + utc_offset: 0, + year: 2090, + zone_abbr: "UTC" + } + end + + test "from_naive with invalid leap second UTC" do + # There were no leap seconds in the middle of 2018 + assert DateTime.from_naive(~N[2018-06-30 23:59:60], "Etc/UTC", FakeTimeZoneDatabase) == + {:error, :invalid_leap_second} + end + + test "from_naive with valid positive leap second non-UTC" do + # 2015-07-01 01:59:60 in "Europe/Copenhagen" was 2015-06-30 23:59:60 in UTC + {:ok, dt} = + DateTime.from_naive(~N[2015-07-01 01:59:60], "Europe/Copenhagen", FakeTimeZoneDatabase) + + assert dt.second == 60 + assert dt.time_zone == "Europe/Copenhagen" + end + + test "from_naive with invalid leap second non-UTC" do + # There were no leap seconds in the middle of 2018 + assert DateTime.from_naive(~N[2018-07-01 02:59:60], "Europe/Copenhagen", FakeTimeZoneDatabase) == + {:error, :invalid_leap_second} + end + + test "from_naive with possible but unknown future positive leap second non-UTC" do + {:outside_leap_second_data_range, datetime} = + DateTime.from_naive(~N[2090-06-30 01:59:60], "Europe/Copenhagen", FakeTimeZoneDatabase) + + assert datetime == %DateTime{ + calendar: Calendar.ISO, + day: 30, + hour: 1, + microsecond: {0, 0}, + minute: 59, + month: 6, + second: 60, + std_offset: 3600, + time_zone: "Europe/Copenhagen", + utc_offset: 3600, + year: 2090, + zone_abbr: "CEST" + } + end + + test "shift_zone for DateTime with a calendar not compatible with ISO" do + {:ok, dt} = + DateTime.from_naive(~N[2018-07-20 00:00:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + + dt_fake_calendar = %{dt | calendar: FakeCalendar} + + assert DateTime.shift_zone(dt_fake_calendar, "America/Los_Angeles", FakeTimeZoneDatabase) == + {:error, :incompatible_calendars} + end + + test "shift zone of leap second from UTC" do + {:ok, dt} = DateTime.from_naive(~N[2015-06-30 23:59:60.123], "Etc/UTC", FakeTimeZoneDatabase) + {:ok, new_dt} = DateTime.shift_zone(dt, "Europe/Copenhagen", FakeTimeZoneDatabase) + + assert new_dt |> Map.from_struct() == %{ + calendar: Calendar.ISO, + day: 1, + hour: 1, + microsecond: {123_000, 3}, + minute: 59, + month: 7, + second: 60, + std_offset: 3600, + time_zone: "Europe/Copenhagen", + utc_offset: 3600, + year: 2015, + zone_abbr: "CEST" + } + end + + test "shift zone" do + holocene_ndt = %NaiveDateTime{ + calendar: Calendar.Holocene, + year: 12018, + month: 7, + day: 1, + hour: 12, + minute: 34, + second: 25, + microsecond: {123_456, 6} + } + + {:ok, holocene_dt} = + DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) + + {:ok, dt} = DateTime.shift_zone(holocene_dt, "America/Los_Angeles", FakeTimeZoneDatabase) + + assert dt == %DateTime{ + calendar: Calendar.Holocene, + day: 1, + hour: 3, + microsecond: {123_456, 6}, + minute: 34, + month: 7, + second: 25, + std_offset: 3600, + time_zone: "America/Los_Angeles", + utc_offset: -28800, + year: 12018, + zone_abbr: "PDT" + } + end +end + +defmodule TimeZoneDatabaseClientTest do + use ExUnit.Case, async: true + doctest TimeZoneDatabaseClient + + test "is leap second TimeZoneData test" do + assert TimeZoneDatabaseClient.is_leap_second(~N[1971-12-31 23:59:60], FakeTimeZoneDatabase) == + {:ok, false} + + assert TimeZoneDatabaseClient.is_leap_second(~N[2018-01-01 00:00:00], FakeTimeZoneDatabase) == + {:ok, false} + + assert TimeZoneDatabaseClient.is_leap_second(~N[1982-06-30 23:59:60], FakeTimeZoneDatabase) == + {:ok, true} + + assert TimeZoneDatabaseClient.is_leap_second(~N[2090-06-30 23:59:60], FakeTimeZoneDatabase) == + {:error, :outside_leap_second_data_range} + end + + test "leap seconds diff" do + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2090-06-30 23:59:60], + ~N[2007-06-30 12:00:00], + FakeTimeZoneDatabase + ) == {:error, :outside_leap_second_data_range} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2007-06-30 12:00:00], + ~N[2090-06-30 23:59:60], + FakeTimeZoneDatabase + ) == {:error, :outside_leap_second_data_range} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[1972-01-01 00:00:00], + ~N[1960-06-30 12:00:00], + FakeTimeZoneDatabase + ) == {:ok, 0} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[1972-07-01 00:00:00], + ~N[1960-06-30 12:00:00], + FakeTimeZoneDatabase + ) == {:ok, 1} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[1972-12-31 23:59:60], + ~N[1972-12-30 12:00:00], + FakeTimeZoneDatabase + ) == {:ok, 1} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[1972-06-30 23:59:60], + ~N[1960-06-30 12:00:00], + FakeTimeZoneDatabase + ) == {:ok, 1} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2015-07-01 00:00:01], + ~N[2015-06-30 23:59:59], + FakeTimeZoneDatabase + ) == {:ok, 1} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2015-06-30 23:59:60], + ~N[2015-06-30 23:59:59], + FakeTimeZoneDatabase + ) == {:ok, 1} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2015-06-30 23:59:60], + ~N[2015-06-30 23:59:60], + FakeTimeZoneDatabase + ) == {:ok, 0} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2016-12-31 23:59:60], + ~N[2015-06-30 23:59:60], + FakeTimeZoneDatabase + ) == {:ok, 1} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2016-12-31 23:59:60], + ~N[2015-06-30 23:59:58], + FakeTimeZoneDatabase + ) == {:ok, 2} + + assert TimeZoneDatabaseClient.leap_second_diff( + ~N[2017-01-01 00:59:59], + ~N[2015-06-30 23:59:58], + FakeTimeZoneDatabase + ) == {:ok, 2} + end end diff --git a/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs b/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs new file mode 100644 index 00000000000..675b2eb9f45 --- /dev/null +++ b/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs @@ -0,0 +1,258 @@ +defmodule FakeTimeZoneDatabase do + @behaviour TimeZoneDatabase + @tai_utc_second_difference_before_1972_06_30_23_59_60_utc 10 + + @time_zone_period_cph_summer_2018 %{ + std_offset: 3600, + utc_offset: 3600, + zone_abbr: "CEST", + from_wall: ~N[2018-03-25 03:00:00], + until_wall: ~N[2018-10-28 03:00:00] + } + + @time_zone_period_cph_winter_2018_2019 %{ + std_offset: 0, + utc_offset: 3600, + zone_abbr: "CET", + from_wall: ~N[2018-10-28 02:00:00], + until_wall: ~N[2019-03-31 02:00:00] + } + + @time_zone_period_cph_summer_2019 %{ + std_offset: 3600, + utc_offset: 3600, + zone_abbr: "CEST", + from_wall: ~N[2019-03-31 03:00:00], + until_wall: ~N[2019-10-27 03:00:00] + } + + @spec time_zone_period_from_utc_iso_days(Calendar.iso_days(), Calendar.time_zone()) :: + {:ok, TimeZoneDatabase.time_zone_period()} | {:error, :time_zone_not_found} + @impl true + def time_zone_period_from_utc_iso_days(iso_days, time_zone) do + {:ok, ndt} = naive_datetime_from_iso_days(iso_days) + time_zone_periods_from_utc(time_zone, NaiveDateTime.to_erl(ndt)) + end + + @spec time_zone_periods_from_wall_datetime(Calendar.naive_datetime(), Calendar.time_zone()) :: + {:single, TimeZoneDatabase.time_zone_period()} + | {:ambiguous, TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period()} + | {:gap, + {TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period_limit()}, + {TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period_limit()}} + | {:error, :time_zone_not_found} + @impl true + def time_zone_periods_from_wall_datetime(naive_datetime, time_zone) do + time_zone_periods_from_wall(time_zone, NaiveDateTime.to_erl(naive_datetime)) + end + + defp time_zone_periods_from_utc("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2018, 3, 25}, {1, 0, 0}} and + erl_datetime < {{2018, 10, 28}, {3, 0, 0}} do + {:ok, @time_zone_period_cph_summer_2018} + end + + defp time_zone_periods_from_utc("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2018, 10, 28}, {2, 0, 0}} and + erl_datetime < {{2019, 3, 31}, {2, 0, 0}} do + {:ok, @time_zone_period_cph_winter_2018_2019} + end + + defp time_zone_periods_from_utc("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2015, 3, 29}, {1, 0, 0}} and + erl_datetime < {{2015, 10, 25}, {1, 0, 0}} do + {:ok, + %{ + std_offset: 3600, + utc_offset: 3600, + zone_abbr: "CEST" + }} + end + + defp time_zone_periods_from_utc("America/Los_Angeles", erl_datetime) + when erl_datetime >= {{2018, 3, 11}, {10, 0, 0}} and + erl_datetime < {{2018, 11, 4}, {9, 0, 0}} do + {:ok, + %{ + std_offset: 3600, + utc_offset: -28800, + zone_abbr: "PDT" + }} + end + + defp time_zone_periods_from_utc(time_zone, _) when time_zone != "Europe/Copenhagen" do + {:error, :time_zone_not_found} + end + + defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2019, 3, 31}, {2, 0, 0}} and + erl_datetime < {{2019, 3, 31}, {3, 0, 0}} do + {:gap, + {@time_zone_period_cph_winter_2018_2019, @time_zone_period_cph_winter_2018_2019.until_wall}, + {@time_zone_period_cph_summer_2019, @time_zone_period_cph_summer_2019.from_wall}} + end + + defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) + when erl_datetime < {{2018, 10, 28}, {3, 0, 0}} and + erl_datetime >= {{2018, 10, 28}, {2, 0, 0}} do + {:ambiguous, @time_zone_period_cph_summer_2018, @time_zone_period_cph_winter_2018_2019} + end + + defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2018, 3, 25}, {3, 0, 0}} and + erl_datetime < {{2018, 10, 28}, {3, 0, 0}} do + {:single, @time_zone_period_cph_summer_2018} + end + + defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2018, 10, 28}, {2, 0, 0}} and + erl_datetime < {{2019, 3, 31}, {2, 0, 0}} do + {:single, @time_zone_period_cph_winter_2018_2019} + end + + defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2019, 3, 31}, {3, 0, 0}} and + erl_datetime < {{2019, 10, 27}, {3, 0, 0}} do + {:single, @time_zone_period_cph_summer_2019} + end + + defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2015, 3, 29}, {3, 0, 0}} and + erl_datetime < {{2015, 10, 25}, {3, 0, 0}} do + {:single, + %{ + std_offset: 3600, + utc_offset: 3600, + zone_abbr: "CEST" + }} + end + + defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) + when erl_datetime >= {{2090, 3, 26}, {3, 0, 0}} and + erl_datetime < {{2090, 10, 29}, {3, 0, 0}} do + {:single, + %{ + std_offset: 3600, + utc_offset: 3600, + zone_abbr: "CEST" + }} + end + + defp time_zone_periods_from_wall(time_zone, _) when time_zone != "Europe/Copenhagen" do + {:error, :time_zone_not_found} + end + + @impl true + def is_leap_second(%{year: year}) when year < 1972 do + {:ok, false} + end + + def is_leap_second(naive_datetime) do + erl_datetime = naive_datetime |> NaiveDateTime.to_erl() + + leap_seconds_only = leap_seconds() |> Enum.map(fn {dt, _} -> dt end) + + case Enum.member?(leap_seconds_only, erl_datetime) do + true -> + {:ok, true} + + false -> + with :ok <- within_leap_second_data_range(naive_datetime) do + {:ok, false} + end + end + end + + @spec leap_second_diff(Calendar.naive_datetime(), Calendar.naive_datetime()) :: integer + @impl true + def leap_second_diff(datetime1, datetime2) do + with :ok <- within_leap_second_data_range(datetime1), + :ok <- within_leap_second_data_range(datetime2) do + tai_diff1 = latest_utc_tai_difference(datetime1) + tai_diff2 = latest_utc_tai_difference(datetime2) + {:ok, tai_diff1 - tai_diff2} + end + end + + # For a specific datetime (UTC) return the difference between UTC and TAI + @spec latest_utc_tai_difference(Calendar.naive_datetime()) :: integer + defp latest_utc_tai_difference(%{ + year: year, + month: month, + day: day, + hour: hour, + minute: minute, + second: second + }) + when {{year, month, day}, {hour, minute, second}} < {{1972, 6, 30}, {23, 59, 60}} do + @tai_utc_second_difference_before_1972_06_30_23_59_60_utc + end + + defp latest_utc_tai_difference(naive_datetime) do + {_, utc_tai_diff} = latest_leap_second_for_datetime(naive_datetime) + utc_tai_diff + end + + @spec latest_leap_second_for_datetime(Calendar.naive_datetime()) :: + {:calendar.datetime(), integer} + defp latest_leap_second_for_datetime(naive_datetime) do + p_erl_datetime = naive_datetime |> NaiveDateTime.to_erl() + + leap_seconds() + |> Enum.filter(fn {leap_second_only, _tai_diff} -> p_erl_datetime >= leap_second_only end) + |> List.last() + end + + @spec within_leap_second_data_range(Calendar.naive_datetime()) :: + :ok | {:error, :outside_leap_second_data_range} + defp within_leap_second_data_range(naive_datetime) do + if NaiveDateTime.to_erl(naive_datetime) > leap_second_data_valid_until() do + {:error, :outside_leap_second_data_range} + else + :ok + end + end + + defp leap_seconds do + [ + {{{1972, 6, 30}, {23, 59, 60}}, 11}, + {{{1972, 12, 31}, {23, 59, 60}}, 12}, + {{{1973, 12, 31}, {23, 59, 60}}, 13}, + {{{1974, 12, 31}, {23, 59, 60}}, 14}, + {{{1975, 12, 31}, {23, 59, 60}}, 15}, + {{{1976, 12, 31}, {23, 59, 60}}, 16}, + {{{1977, 12, 31}, {23, 59, 60}}, 17}, + {{{1978, 12, 31}, {23, 59, 60}}, 18}, + {{{1979, 12, 31}, {23, 59, 60}}, 19}, + {{{1981, 6, 30}, {23, 59, 60}}, 20}, + {{{1982, 6, 30}, {23, 59, 60}}, 21}, + {{{1983, 6, 30}, {23, 59, 60}}, 22}, + {{{1985, 6, 30}, {23, 59, 60}}, 23}, + {{{1987, 12, 31}, {23, 59, 60}}, 24}, + {{{1989, 12, 31}, {23, 59, 60}}, 25}, + {{{1990, 12, 31}, {23, 59, 60}}, 26}, + {{{1992, 6, 30}, {23, 59, 60}}, 27}, + {{{1993, 6, 30}, {23, 59, 60}}, 28}, + {{{1994, 6, 30}, {23, 59, 60}}, 29}, + {{{1995, 12, 31}, {23, 59, 60}}, 30}, + {{{1997, 6, 30}, {23, 59, 60}}, 31}, + {{{1998, 12, 31}, {23, 59, 60}}, 32}, + {{{2005, 12, 31}, {23, 59, 60}}, 33}, + {{{2008, 12, 31}, {23, 59, 60}}, 34}, + {{{2012, 6, 30}, {23, 59, 60}}, 35}, + {{{2015, 6, 30}, {23, 59, 60}}, 36}, + {{{2016, 12, 31}, {23, 59, 60}}, 37} + ] + end + + defp leap_second_data_valid_until do + {{2018, 12, 28}, {0, 0, 0}} + end + + defp naive_datetime_from_iso_days(iso_days) do + {year, month, day, hour, minute, second, microsecond} = + Calendar.ISO.naive_datetime_from_iso_days(iso_days) + + NaiveDateTime.new(year, month, day, hour, minute, second, microsecond) + end +end From b116d833f693fec734af0806725950d8e9006296 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Mon, 12 Nov 2018 11:54:57 +0100 Subject: [PATCH 02/10] Remove leap seconds client and streamline shift_zone --- lib/elixir/lib/calendar/datetime.ex | 468 ++++-------------- lib/elixir/lib/calendar/iso.ex | 13 +- lib/elixir/lib/calendar/naive_datetime.ex | 7 +- lib/elixir/lib/calendar/time.ex | 16 +- lib/elixir/lib/calendar/time_zone_database.ex | 55 +- lib/elixir/test/elixir/calendar_test.exs | 321 +++--------- .../calendar/fake_time_zone_database.exs | 108 ---- 7 files changed, 198 insertions(+), 790 deletions(-) diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index 43f1835cbd4..fb0953417f3 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -217,7 +217,6 @@ defmodule DateTime do TimeZoneDatabaseClient.tz_db_or_config() ) :: {:ok, t} - | {:outside_leap_second_data_range, t} | {:ambiguous, t, t} | {:gap, t, t} | {:error, :time_zone_not_found} @@ -226,23 +225,9 @@ defmodule DateTime do def from_naive(naive_datetime, time_zone, tz_db_or_config \\ :from_config) - def from_naive(%{second: 60} = naive_datetime, "Etc/UTC", tz_db_or_config) do - {:ok, dt} = do_from_naive(naive_datetime, "Etc/UTC", 0, 0, "UTC") - - case validate_positive_leap_second(dt, tz_db_or_config) do - :ok -> - {:ok, dt} - - {:error, :outside_leap_second_data_range} -> - {:outside_leap_second_data_range, dt} - - error -> - error - end - end - def from_naive(naive_datetime, "Etc/UTC", _) do - do_from_naive(naive_datetime, "Etc/UTC", 0, 0, "UTC") + utc_period = %{std_offset: 0, utc_offset: 0, zone_abbr: "UTC"} + {:ok, from_naive_with_period(naive_datetime, "Etc/UTC", utc_period)} end def from_naive(%{calendar: Calendar.ISO} = naive_datetime, time_zone, tz_db_or_config) do @@ -252,34 +237,11 @@ defmodule DateTime do tz_db_or_config ) do {:single, period} -> - do_from_naive_check_leap_second( - naive_datetime, - time_zone, - period.std_offset, - period.utc_offset, - period.zone_abbr, - tz_db_or_config - ) + {:ok, from_naive_with_period(naive_datetime, time_zone, period)} {:ambiguous, first_period, second_period} -> - {:ok, first_datetime} = - do_from_naive( - naive_datetime, - time_zone, - first_period.std_offset, - first_period.utc_offset, - first_period.zone_abbr - ) - - {:ok, second_datetime} = - do_from_naive( - naive_datetime, - time_zone, - second_period.std_offset, - second_period.utc_offset, - second_period.zone_abbr - ) - + first_datetime = from_naive_with_period(naive_datetime, time_zone, first_period) + second_datetime = from_naive_with_period(naive_datetime, time_zone, second_period) {:ambiguous, first_datetime, second_datetime} {:gap, {first_period, first_period_until_wall}, {second_period, second_period_from_wall}} -> @@ -293,24 +255,8 @@ defmodule DateTime do after_naive = second_period_from_wall - {:ok, latest_datetime_before} = - do_from_naive( - before_naive, - time_zone, - first_period.std_offset, - first_period.utc_offset, - first_period.zone_abbr - ) - - {:ok, first_datetime_after} = - do_from_naive( - after_naive, - time_zone, - second_period.std_offset, - second_period.utc_offset, - second_period.zone_abbr - ) - + latest_datetime_before = from_naive_with_period(before_naive, time_zone, first_period) + first_datetime_after = from_naive_with_period(after_naive, time_zone, second_period) {:gap, latest_datetime_before, first_datetime_after} {:error, _} = error -> @@ -346,39 +292,9 @@ defmodule DateTime do end end - # This assumes there are no time zones with offsets other than whole minutes during - # the period where leap seconds are in use. - defp do_from_naive_check_leap_second( - %{second: 60} = naive_datetime, - time_zone, - std_offset, - utc_offset, - zone_abbr, - tz_db_or_config - ) do - {:ok, datetime} = do_from_naive(naive_datetime, time_zone, std_offset, utc_offset, zone_abbr) - utc_dt = to_zero_total_offset(datetime) - - case TimeZoneDatabaseClient.is_leap_second(utc_dt, tz_db_or_config) do - {:ok, true} -> {:ok, datetime} - {:ok, false} -> {:error, :invalid_leap_second} - {:error, :outside_leap_second_data_range} -> {:outside_leap_second_data_range, datetime} - {:error, _} = error -> error - end - end - - defp do_from_naive_check_leap_second( - naive_datetime, - time_zone, - std_offset, - utc_offset, - zone_abbr, - _ - ) do - do_from_naive(naive_datetime, time_zone, std_offset, utc_offset, zone_abbr) - end + defp from_naive_with_period(naive_datetime, time_zone, period) do + %{std_offset: std_offset, utc_offset: utc_offset, zone_abbr: zone_abbr} = period - defp do_from_naive(naive_datetime, time_zone, std_offset, utc_offset, zone_abbr) do %{ calendar: calendar, hour: hour, @@ -390,7 +306,7 @@ defmodule DateTime do day: day } = naive_datetime - datetime = %DateTime{ + %DateTime{ calendar: calendar, year: year, month: month, @@ -404,8 +320,6 @@ defmodule DateTime do zone_abbr: zone_abbr, time_zone: time_zone } - - {:ok, datetime} end @doc """ @@ -439,41 +353,12 @@ defmodule DateTime do end end - # Takes a datetime and in case it is is on the 61st second (60) it will check - # if it is a known leap second. All datetimes with non ISO calendars return :ok - @spec validate_positive_leap_second( - Calendar.datetime(), - TimeZoneDatabaseClient.tz_db_or_config() - ) :: :ok | {:error, atom} - defp validate_positive_leap_second(%{second: second, calendar: calendar}, _) - when second != 60 or calendar != Calendar.ISO do - :ok - end - - defp validate_positive_leap_second( - %{utc_offset: utc_offset, std_offset: std_offset} = dt, - tz_db_or_config - ) - when utc_offset + std_offset == 0 do - utc_dt = to_zero_total_offset(dt) - - case TimeZoneDatabaseClient.is_leap_second(utc_dt, tz_db_or_config) do - {:ok, true} -> - :ok - - {:ok, false} -> - {:error, :invalid_leap_second} - - {:error, _} = error -> - error - end - end - @doc """ Changes the time zone of a `DateTime`. Returns a `DateTime` for the same point in time, but instead at the time zone - provided. + provided. It assumes that `DateTime` is valid and exists in the given timezone + and calendar. Requires passing a `TimeZoneDatabase` as an argument or setting it with `TimeZoneDatabaseClient.set_database/1`. @@ -486,7 +371,7 @@ defmodule DateTime do #DateTime<2018-07-16 03:00:00-07:00 PDT America/Los_Angeles> """ - @doc since: "1.8.0-dev" + @doc since: "1.8.0" @spec shift_zone(t, Calendar.time_zone(), TimeZoneDatabaseClient.tz_db_or_config()) :: {:ok, t} | {:error, :time_zone_not_found} | {:error, atom} def shift_zone(datetime, time_zone, tz_db_or_config \\ :from_config) @@ -496,27 +381,8 @@ defmodule DateTime do {:ok, datetime} end - def shift_zone(%{second: 60, calendar: Calendar.ISO} = datetime, time_zone, tz_db_or_config) do - # If second is 60 (positive leap second) adjust it to 59, calculate, then adjust back to 60. - case shift_zone(%{datetime | second: 59}, time_zone, tz_db_or_config) do - {:ok, %{second: second} = dt_result} when second == 59 -> - {:ok, %{dt_result | second: 60}} - - {:ok, _} -> - {:error, :non_whole_minute_offsets_not_supported_for_leap_seconds} - - error -> - error - end - end - def shift_zone( - %{ - calendar: Calendar.ISO, - std_offset: std_offset, - utc_offset: utc_offset, - microsecond: {_, microsecond_precision} - } = datetime, + %{std_offset: std_offset, utc_offset: utc_offset} = datetime, time_zone, tz_db_or_config ) do @@ -530,52 +396,36 @@ defmodule DateTime do time_zone, tz_db_or_config ) do - {:ok, period} -> - naive_datetime = + {:ok, %{std_offset: std_offset, utc_offset: utc_offset, zone_abbr: zone_abbr}} -> + %{calendar: calendar, microsecond: {_, microsecond_precision}} = datetime + + {year, month, day, hour, minute, second, {microsecond_without_precision, _}} = datetime_in_utc_iso_days - |> apply_tz_offset(-period.utc_offset - period.std_offset) - |> iso_days_to_iso_naive_datetime(microsecond_precision) + |> apply_tz_offset(-utc_offset - std_offset) + |> calendar.naive_datetime_from_iso_days() - do_from_naive( - naive_datetime, - time_zone, - period.std_offset, - period.utc_offset, - period.zone_abbr - ) + datetime = %DateTime{ + calendar: calendar, + year: year, + month: month, + day: day, + hour: hour, + minute: minute, + second: second, + microsecond: {microsecond_without_precision, microsecond_precision}, + std_offset: std_offset, + utc_offset: utc_offset, + zone_abbr: zone_abbr, + time_zone: time_zone + } + + {:ok, datetime} {:error, _} = error -> error end end - def shift_zone(%{calendar: calendar} = datetime, time_zone, tz_db_or_config) - when calendar != Calendar.ISO do - with {:ok, iso_datetime} <- DateTime.convert(datetime, Calendar.ISO), - {:ok, shifted_zone_iso_dt} <- shift_zone(iso_datetime, time_zone, tz_db_or_config), - {:ok, shifted_zone_original_calendar_dt} <- convert(shifted_zone_iso_dt, calendar) do - {:ok, shifted_zone_original_calendar_dt} - end - end - - # Takes Calendar.naive_datetime and makes sure it has a zero total offset - @spec to_zero_total_offset(Calendar.naive_datetime()) :: Calendar.naive_datetime() - defp to_zero_total_offset(%{utc_offset: utc_offset, std_offset: std_offset} = datetime) - when utc_offset + std_offset == 0 do - # If the offset is already zero, return the datetime unchanged - datetime - end - - defp to_zero_total_offset(%{calendar: Calendar.ISO, second: 60} = datetime) do - datetime_with_second_59 = to_zero_total_offset(%{datetime | second: 59}) - %{datetime_with_second_59 | second: 60} - end - - defp to_zero_total_offset(%{calendar: Calendar.ISO} = datetime) do - datetime - |> NaiveDateTime.add(-1 * (datetime.utc_offset + datetime.std_offset)) - end - @doc """ Returns the current datetime in the provided time zone. @@ -591,6 +441,7 @@ defmodule DateTime do {:error, :time_zone_not_found} """ + @doc since: "1.8.0" @spec now(Calendar.time_zone(), TimeZoneDatabaseClient.tz_db_or_config()) :: {:ok, t} | {:error, :time_zone_not_found} def now(time_zone, tz_db_or_config \\ :from_config) @@ -826,13 +677,9 @@ defmodule DateTime do Time representations with reduced accuracy are not supported. - Note that while ISO 8601 allows datetimes to specify 24:00:00 as the + Note that while ISO 8601 allows times to specify 24:00:00 as the zero hour of the next day, this notation is not supported by Elixir. - - Validates positive leap seconds (when the second is 60). When passed a - valid positive leap second, `{:error, :no_time_zone_database}` an error will - be returned unless a `TimeZoneDatabase` has been passed as the third argument - or set with `TimeZoneDatabaseClient.set_database/1`. + Leap seconds are not supported as well by the built-in Calendar.ISO. ## Examples @@ -867,45 +714,25 @@ defmodule DateTime do iex> DateTime.from_iso8601("2015-01-23T23:50:07.123-00:00") {:error, :invalid_format} - ## Examples with positive leap seconds - - iex> {:ok, datetime, 0} = DateTime.from_iso8601("2015-06-30 23:59:60Z", Calendar.ISO, FakeTimeZoneDatabase) - iex> datetime - #DateTime<2015-06-30 23:59:60Z> - - iex> DateTime.from_iso8601("2018-07-01 01:59:60+02:00", Calendar.ISO, FakeTimeZoneDatabase) - {:error, :invalid_leap_second} - iex> {:outside_leap_second_data_range, datetime, 7200} = DateTime.from_iso8601("2090-07-01 01:59:60+02:00", Calendar.ISO, FakeTimeZoneDatabase) - iex> datetime - #DateTime<2090-06-30 23:59:60Z> - - If a TimeZoneDatabase has not been set with - `TimeZoneDatabaseClient.set_database/1` and the second of the parsed datetime is 60: - - iex> DateTime.from_iso8601("2018-07-01 01:59:60+02:00") - {:error, :no_time_zone_database} - """ @doc since: "1.4.0" - @spec from_iso8601(String.t(), Calendar.calendar(), TimeZoneDatabaseClient.tz_db_or_config()) :: - {:ok, t, Calendar.utc_offset()} - | {:outside_leap_second_data_range, t, Calendar.utc_offset()} - | {:error, atom} - def from_iso8601(string, calendar \\ Calendar.ISO, tz_db_or_config \\ :from_config) - - def from_iso8601(<>, calendar, tz_db_or_config) do - raw_from_iso8601(rest, calendar, tz_db_or_config, true) + @spec from_iso8601(String.t(), Calendar.calendar()) :: + {:ok, t, Calendar.utc_offset()} | {:error, atom} + def from_iso8601(string, calendar \\ Calendar.ISO) + + def from_iso8601(<>, calendar) do + raw_from_iso8601(rest, calendar, true) end - def from_iso8601(<>, calendar, tz_db_or_config) do - raw_from_iso8601(rest, calendar, tz_db_or_config, false) + def from_iso8601(<>, calendar) do + raw_from_iso8601(rest, calendar, false) end @sep [?\s, ?T] [match_date, guard_date, read_date] = Calendar.ISO.__match_date__() [match_time, guard_time, read_time] = Calendar.ISO.__match_time__() - defp raw_from_iso8601(string, calendar, tz_db_or_config, is_year_negative) do + defp raw_from_iso8601(string, calendar, is_year_negative) do with <> <- string, true <- unquote(guard_date) and sep in @sep and unquote(guard_time), {microsecond, rest} <- Calendar.ISO.parse_microsecond(rest), @@ -914,133 +741,71 @@ defmodule DateTime do {hour, minute, second} = unquote(read_time) year = if is_year_negative, do: -year, else: year - do_from_iso8601( - year, - month, - day, - hour, - minute, - second, - microsecond, - offset, - calendar, - tz_db_or_config - ) + cond do + not calendar.valid_date?(year, month, day) -> + {:error, :invalid_date} + + not calendar.valid_time?(hour, minute, second, microsecond) -> + {:error, :invalid_time} + + offset == 0 -> + datetime = %DateTime{ + calendar: calendar, + year: year, + month: month, + day: day, + hour: hour, + minute: minute, + second: second, + microsecond: microsecond, + std_offset: 0, + utc_offset: 0, + zone_abbr: "UTC", + time_zone: "Etc/UTC" + } + + {:ok, datetime, 0} + + is_nil(offset) -> + {:error, :missing_offset} + + true -> + day_fraction = Calendar.ISO.time_to_day_fraction(hour, minute, second, {0, 0}) + + {{year, month, day}, {hour, minute, second, _}} = + case apply_tz_offset({0, day_fraction}, offset) do + {0, day_fraction} -> + {{year, month, day}, Calendar.ISO.time_from_day_fraction(day_fraction)} + + {extra_days, day_fraction} -> + base_days = Calendar.ISO.date_to_iso_days(year, month, day) + + {Calendar.ISO.date_from_iso_days(base_days + extra_days), + Calendar.ISO.time_from_day_fraction(day_fraction)} + end + + datetime = %DateTime{ + calendar: calendar, + year: year, + month: month, + day: day, + hour: hour, + minute: minute, + second: second, + microsecond: microsecond, + std_offset: 0, + utc_offset: 0, + zone_abbr: "UTC", + time_zone: "Etc/UTC" + } + + {:ok, datetime, offset} + end else _ -> {:error, :invalid_format} end end - defp do_from_iso8601( - year, - month, - day, - hour, - minute, - second, - microsecond, - offset, - calendar, - tz_db_or_config - ) do - cond do - not calendar.valid_date?(year, month, day) -> - {:error, :invalid_date} - - not calendar.valid_time?(hour, minute, second, microsecond) -> - {:error, :invalid_time} - - offset == 0 -> - datetime = %DateTime{ - calendar: calendar, - year: year, - month: month, - day: day, - hour: hour, - minute: minute, - second: second, - microsecond: microsecond, - std_offset: 0, - utc_offset: 0, - zone_abbr: "UTC", - time_zone: "Etc/UTC" - } - - case validate_positive_leap_second(datetime, tz_db_or_config) do - :ok -> - {:ok, datetime, 0} - - error -> - error - end - - is_nil(offset) -> - {:error, :missing_offset} - - second == 60 && calendar == Calendar.ISO -> - # Get the datetime as if the second is 59, then set the second back to 60 - # and check that it is a valid leap second. - with {:ok, datetime, offset} <- - do_from_iso8601( - year, - month, - day, - hour, - minute, - 59, - microsecond, - offset, - calendar, - tz_db_or_config - ) do - datetime = %{datetime | second: 60, microsecond: microsecond} - - case validate_positive_leap_second(datetime, tz_db_or_config) do - :ok -> - {:ok, datetime, offset} - - {:error, :outside_leap_second_data_range} -> - {:outside_leap_second_data_range, datetime, offset} - - error -> - error - end - end - - true -> - day_fraction = Calendar.ISO.time_to_day_fraction(hour, minute, second, {0, 0}) - - {{year, month, day}, {hour, minute, second, _}} = - case apply_tz_offset({0, day_fraction}, offset) do - {0, day_fraction} -> - {{year, month, day}, Calendar.ISO.time_from_day_fraction(day_fraction)} - - {extra_days, day_fraction} -> - base_days = Calendar.ISO.date_to_iso_days(year, month, day) - - {Calendar.ISO.date_from_iso_days(base_days + extra_days), - Calendar.ISO.time_from_day_fraction(day_fraction)} - end - - datetime = %DateTime{ - calendar: calendar, - year: year, - month: month, - day: day, - hour: hour, - minute: minute, - second: second, - microsecond: microsecond, - std_offset: 0, - utc_offset: 0, - zone_abbr: "UTC", - time_zone: "Etc/UTC" - } - - {:ok, datetime, offset} - end - end - @doc """ Converts the given `datetime` to a string according to its calendar. @@ -1345,23 +1110,6 @@ defmodule DateTime do Calendar.ISO.add_day_fraction_to_iso_days(iso_days, -offset, 86400) end - @spec iso_days_to_iso_naive_datetime(Calendar.iso_days(), 0..6) :: NaiveDateTime.t() - defp iso_days_to_iso_naive_datetime(iso_days, microsecond_precision) do - {year, month, day, hour, minute, second, {microsecond_without_precision, _}} = - Calendar.ISO.naive_datetime_from_iso_days(iso_days) - - %NaiveDateTime{ - calendar: Calendar.ISO, - year: year, - month: month, - day: day, - hour: hour, - minute: minute, - second: second, - microsecond: {microsecond_without_precision, microsecond_precision} - } - end - defimpl String.Chars do def to_string(datetime) do %{ diff --git a/lib/elixir/lib/calendar/iso.ex b/lib/elixir/lib/calendar/iso.ex index 8c4e265a185..4e6dfac15b0 100644 --- a/lib/elixir/lib/calendar/iso.ex +++ b/lib/elixir/lib/calendar/iso.ex @@ -26,7 +26,7 @@ defmodule Calendar.ISO do @seconds_per_minute 60 @seconds_per_hour 60 * 60 - # Note that this does _not_ handle leap seconds. + # Note that this does *not* handle leap seconds. @seconds_per_day 24 * 60 * 60 @last_second_of_the_day @seconds_per_day - 1 @microseconds_per_second 1_000_000 @@ -507,15 +507,17 @@ defmodule Calendar.ISO do @doc """ Determines if the date given is valid according to the proleptic Gregorian calendar. - Note that leap seconds are considered valid, but the use of 24:00:00 as the - zero hour of the day is considered invalid. + + Note that while ISO 8601 allows times to specify 24:00:00 as the + zero hour of the next day, this notation is not supported by Elixir. + Leap seconds are not supported as well by the built-in Calendar.ISO. ## Examples iex> Calendar.ISO.valid_time?(10, 50, 25, {3006, 6}) true iex> Calendar.ISO.valid_time?(23, 59, 60, {0, 0}) - true + false iex> Calendar.ISO.valid_time?(24, 0, 0, {0, 0}) false @@ -525,7 +527,7 @@ defmodule Calendar.ISO do @spec valid_time?(Calendar.hour(), Calendar.minute(), Calendar.second(), Calendar.microsecond()) :: boolean def valid_time?(hour, minute, second, {microsecond, precision}) do - hour in 0..23 and minute in 0..59 and second in 0..60 and microsecond in 0..999_999 and + hour in 0..23 and minute in 0..59 and second in 0..59 and microsecond in 0..999_999 and precision in 0..6 end @@ -856,7 +858,6 @@ defmodule Calendar.ISO do {12, day_of_year - (334 + extra_day)} end - @spec iso_seconds_to_datetime(integer) :: :calendar.datetime() defp iso_seconds_to_datetime(seconds) do {days, rest_seconds} = div_mod(seconds, @seconds_per_day) diff --git a/lib/elixir/lib/calendar/naive_datetime.ex b/lib/elixir/lib/calendar/naive_datetime.ex index 906ace0223c..7d8eae3394e 100644 --- a/lib/elixir/lib/calendar/naive_datetime.ex +++ b/lib/elixir/lib/calendar/naive_datetime.ex @@ -141,13 +141,11 @@ defmodule NaiveDateTime do {:ok, ~N[2000-01-01 23:59:59.0]} iex> NaiveDateTime.new(2000, 1, 1, 23, 59, 59, 999_999) {:ok, ~N[2000-01-01 23:59:59.999999]} - iex> NaiveDateTime.new(2000, 1, 1, 23, 59, 60, 999_999) - {:ok, ~N[2000-01-01 23:59:60.999999]} iex> NaiveDateTime.new(2000, 1, 1, 24, 59, 59, 999_999) {:error, :invalid_time} iex> NaiveDateTime.new(2000, 1, 1, 23, 60, 59, 999_999) {:error, :invalid_time} - iex> NaiveDateTime.new(2000, 1, 1, 23, 59, 61, 999_999) + iex> NaiveDateTime.new(2000, 1, 1, 23, 59, 60, 999_999) {:error, :invalid_time} iex> NaiveDateTime.new(2000, 1, 1, 23, 59, 59, 1_000_000) {:error, :invalid_time} @@ -513,8 +511,9 @@ defmodule NaiveDateTime do Time representations with reduced accuracy are not supported. - Note that while ISO 8601 allows datetimes to specify 24:00:00 as the + Note that while ISO 8601 allows times to specify 24:00:00 as the zero hour of the next day, this notation is not supported by Elixir. + Leap seconds are not supported as well by the built-in Calendar.ISO. ## Examples diff --git a/lib/elixir/lib/calendar/time.ex b/lib/elixir/lib/calendar/time.ex index ed221aa7bbb..bab2ba66fdd 100644 --- a/lib/elixir/lib/calendar/time.ex +++ b/lib/elixir/lib/calendar/time.ex @@ -80,9 +80,10 @@ defmodule Time do Expects all values to be integers. Returns `{:ok, time}` if each entry fits its appropriate range, returns `{:error, reason}` otherwise. - Note a time may have 60 seconds in case of leap seconds. Microseconds - can also be given with a precision, which must be an integer between - 0 and 6. + Microseconds can also be given with a precision, which must be an + integer between 0 and 6. + + The built-in calendar does not support leap seconds. ## Examples @@ -90,18 +91,12 @@ defmodule Time do {:ok, ~T[00:00:00.000000]} iex> Time.new(23, 59, 59, 999_999) {:ok, ~T[23:59:59.999999]} - iex> Time.new(23, 59, 60, 999_999) - {:ok, ~T[23:59:60.999999]} - - # Time with microseconds and their precision - iex> Time.new(23, 59, 60, {10_000, 2}) - {:ok, ~T[23:59:60.01]} iex> Time.new(24, 59, 59, 999_999) {:error, :invalid_time} iex> Time.new(23, 60, 59, 999_999) {:error, :invalid_time} - iex> Time.new(23, 59, 61, 999_999) + iex> Time.new(23, 59, 60, 999_999) {:error, :invalid_time} iex> Time.new(23, 59, 59, 1_000_000) {:error, :invalid_time} @@ -189,6 +184,7 @@ defmodule Time do Note that while ISO 8601 allows times to specify 24:00:00 as the zero hour of the next day, this notation is not supported by Elixir. + Leap seconds are not supported as well by the built-in Calendar.ISO. ## Examples diff --git a/lib/elixir/lib/calendar/time_zone_database.ex b/lib/elixir/lib/calendar/time_zone_database.ex index e82cb1bb4c1..9545abb0c2c 100644 --- a/lib/elixir/lib/calendar/time_zone_database.ex +++ b/lib/elixir/lib/calendar/time_zone_database.ex @@ -2,8 +2,8 @@ defmodule TimeZoneDatabase do @moduledoc """ This module defines a behaviour for providing time zone data. - IANA provides time zone data that includes data about different UTC offsets, - standard offsets for timezones as well as leap second data. + IANA provides time zone data that includes data about different + UTC offsets and standard offsets for timezones. """ @typedoc """ @@ -66,35 +66,6 @@ defmodule TimeZoneDatabase do | {:gap, {time_zone_period, time_zone_period_limit}, {time_zone_period, time_zone_period_limit}} | {:error, :time_zone_not_found} - - @doc """ - Determine if a datetime is a leap second or not. - - Takes a `Calendar.naive_datetime` and returns {:ok, true} if it is a - leap second. {:ok, false} if it is not. - - It cannot be predicted exactly when all leap seconds will be introduced in - the future. Every six months it is announced whether there will be a leap - second or not at the end of the coming June or December. If this function is - queried with a datetime that is so far into the future that it is has not - yet been announced if there will be a leap second or not - `{:error, :outside_leap_second_data_range}` should be returned. - """ - @callback is_leap_second(Calander.naive_datetime()) :: - {:ok, boolean} | {:error, :outside_leap_second_data_range} - - @doc """ - The difference in seconds between two datetimes. - - Takes two `Calendar.naive_datetime`s. They should represent UTC datetimes. - - Returns the difference in leap seconds between them. For instance when passed - `~N[2018-01-01 00:00:00]` and `~N[2014-01-01 00:00:00]` it should return `{:ok, 2}` - representing two leap seconds. - """ - @callback leap_second_diff(Calendar.naive_datetime(), Calendar.naive_datetime()) :: - {:ok, integer} - | {:error, :outside_leap_second_data_range} end defmodule TimeZoneDatabaseClient do @@ -161,28 +132,6 @@ defmodule TimeZoneDatabaseClient do end end - @doc false - @spec is_leap_second(Calendar.naive_datetime(), tz_db_or_config) :: - {:ok, boolean} - | {:error, :outside_leap_second_data_range} - | {:error, :no_time_zone_database} - def is_leap_second(naive_datetime, tz_db_or_config) do - with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do - time_zone_database.is_leap_second(naive_datetime) - end - end - - @doc false - @spec leap_second_diff(Calendar.naive_datetime(), Calendar.naive_datetime(), tz_db_or_config) :: - {:ok, boolean} - | {:error, :no_time_zone_database} - | {:error, :outside_leap_second_data_range} - def leap_second_diff(datetime1, datetime2, tz_db_or_config) do - with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do - time_zone_database.leap_second_diff(datetime1, datetime2) - end - end - @spec time_zone_database_from_tz_db_or_config(tz_db_or_config) :: {:ok, TimeZoneDatabase.t()} | {:error, :no_time_zone_database} defp time_zone_database_from_tz_db_or_config(:from_config) do diff --git a/lib/elixir/test/elixir/calendar_test.exs b/lib/elixir/test/elixir/calendar_test.exs index 3d217f8d46c..bf6fb675c14 100644 --- a/lib/elixir/test/elixir/calendar_test.exs +++ b/lib/elixir/test/elixir/calendar_test.exs @@ -518,29 +518,6 @@ defmodule DateTimeTest do assert DateTime.from_iso8601("2015-01-23T23:50:07.123-00:60") == {:error, :invalid_format} end - test "from_iso8601 handles leap seconds correctly" do - assert DateTime.from_iso8601("2018-06-30 23:59:60Z", Calendar.ISO, FakeTimeZoneDatabase) == - {:error, :invalid_leap_second} - - {:ok, datetime, 0} = - DateTime.from_iso8601("2015-06-30 23:59:60Z", Calendar.ISO, FakeTimeZoneDatabase) - - assert datetime == %DateTime{ - calendar: Calendar.ISO, - day: 30, - hour: 23, - microsecond: {0, 0}, - minute: 59, - month: 6, - second: 60, - std_offset: 0, - time_zone: "Etc/UTC", - utc_offset: 0, - year: 2015, - zone_abbr: "UTC" - } - end - test "from_unix/2" do min_datetime = %DateTime{ calendar: Calendar.ISO, @@ -911,145 +888,84 @@ defmodule DateTimeTest do assert DateTime.diff(dt1, dt2) == 3_281_904_000 end - test "from_naive" do - holocene_ndt = %NaiveDateTime{ - calendar: Calendar.Holocene, - year: 12018, - month: 7, - day: 1, - hour: 12, - minute: 34, - second: 25, - microsecond: {123_456, 6} - } - - assert DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) == - {:ok, - %DateTime{ - calendar: Calendar.Holocene, - day: 1, - hour: 12, - microsecond: {123_456, 6}, - minute: 34, - month: 7, - second: 25, - std_offset: 3600, - time_zone: "Europe/Copenhagen", - utc_offset: 3600, - year: 12018, - zone_abbr: "CEST" - }} - end - - test "from_naive with calendar not compatible with ISO" do - ndt = %{~N[2018-07-20 00:00:00] | calendar: FakeCalendar} - - assert DateTime.from_naive(ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) == - {:error, :incompatible_calendars} - end - - test "from_naive with valid positive leap second UTC" do - ndt = ~N[1982-06-30 23:59:60] - - {:ok, dt} = DateTime.from_naive(ndt, "Etc/UTC", FakeTimeZoneDatabase) - assert dt.second == 60 - assert dt.time_zone == "Etc/UTC" - end - - test "from_naive with possible but unknown future positive leap second UTC" do - ndt = ~N[2090-06-30 23:59:60] - - {:outside_leap_second_data_range, datetime} = - DateTime.from_naive(ndt, "Etc/UTC", FakeTimeZoneDatabase) - - assert datetime == %DateTime{ - calendar: Calendar.ISO, - day: 30, - hour: 23, - microsecond: {0, 0}, - minute: 59, - month: 6, - second: 60, - std_offset: 0, - time_zone: "Etc/UTC", - utc_offset: 0, - year: 2090, - zone_abbr: "UTC" - } - end - - test "from_naive with invalid leap second UTC" do - # There were no leap seconds in the middle of 2018 - assert DateTime.from_naive(~N[2018-06-30 23:59:60], "Etc/UTC", FakeTimeZoneDatabase) == - {:error, :invalid_leap_second} - end - - test "from_naive with valid positive leap second non-UTC" do - # 2015-07-01 01:59:60 in "Europe/Copenhagen" was 2015-06-30 23:59:60 in UTC - {:ok, dt} = - DateTime.from_naive(~N[2015-07-01 01:59:60], "Europe/Copenhagen", FakeTimeZoneDatabase) - - assert dt.second == 60 - assert dt.time_zone == "Europe/Copenhagen" - end - - test "from_naive with invalid leap second non-UTC" do - # There were no leap seconds in the middle of 2018 - assert DateTime.from_naive(~N[2018-07-01 02:59:60], "Europe/Copenhagen", FakeTimeZoneDatabase) == - {:error, :invalid_leap_second} - end - - test "from_naive with possible but unknown future positive leap second non-UTC" do - {:outside_leap_second_data_range, datetime} = - DateTime.from_naive(~N[2090-06-30 01:59:60], "Europe/Copenhagen", FakeTimeZoneDatabase) - - assert datetime == %DateTime{ - calendar: Calendar.ISO, - day: 30, - hour: 1, - microsecond: {0, 0}, - minute: 59, - month: 6, - second: 60, - std_offset: 3600, - time_zone: "Europe/Copenhagen", - utc_offset: 3600, - year: 2090, - zone_abbr: "CEST" - } - end - - test "shift_zone for DateTime with a calendar not compatible with ISO" do - {:ok, dt} = - DateTime.from_naive(~N[2018-07-20 00:00:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + describe "from_naive" do + test "with compatible calendar on unambiguous wall clock" do + holocene_ndt = %NaiveDateTime{ + calendar: Calendar.Holocene, + year: 12018, + month: 7, + day: 1, + hour: 12, + minute: 34, + second: 25, + microsecond: {123_456, 6} + } + + assert DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) == + {:ok, + %DateTime{ + calendar: Calendar.Holocene, + day: 1, + hour: 12, + microsecond: {123_456, 6}, + minute: 34, + month: 7, + second: 25, + std_offset: 3600, + time_zone: "Europe/Copenhagen", + utc_offset: 3600, + year: 12018, + zone_abbr: "CEST" + }} + end - dt_fake_calendar = %{dt | calendar: FakeCalendar} + test "with compatible calendar on ambiguous wall clock" do + holocene_ndt = %NaiveDateTime{ + calendar: Calendar.Holocene, + year: 12018, + month: 10, + day: 28, + hour: 02, + minute: 30, + second: 00, + microsecond: {123_456, 6} + } + + assert {:ambiguous, first_dt, second_dt} = + DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) + + assert %DateTime{calendar: Calendar.Holocene, zone_abbr: "CEST"} = first_dt + assert %DateTime{calendar: Calendar.Holocene, zone_abbr: "CET"} = second_dt + end - assert DateTime.shift_zone(dt_fake_calendar, "America/Los_Angeles", FakeTimeZoneDatabase) == - {:error, :incompatible_calendars} - end + test "with compatible calendar on gap" do + holocene_ndt = %NaiveDateTime{ + calendar: Calendar.Holocene, + year: 12019, + month: 03, + day: 31, + hour: 02, + minute: 30, + second: 00, + microsecond: {123_456, 6} + } + + assert {:gap, first_dt, second_dt} = + DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) + + assert %DateTime{calendar: Calendar.Holocene, zone_abbr: "CET"} = first_dt + assert %DateTime{calendar: Calendar.Holocene, zone_abbr: "CEST"} = second_dt + end - test "shift zone of leap second from UTC" do - {:ok, dt} = DateTime.from_naive(~N[2015-06-30 23:59:60.123], "Etc/UTC", FakeTimeZoneDatabase) - {:ok, new_dt} = DateTime.shift_zone(dt, "Europe/Copenhagen", FakeTimeZoneDatabase) + test "with incompatible calendar" do + ndt = %{~N[2018-07-20 00:00:00] | calendar: FakeCalendar} - assert new_dt |> Map.from_struct() == %{ - calendar: Calendar.ISO, - day: 1, - hour: 1, - microsecond: {123_000, 3}, - minute: 59, - month: 7, - second: 60, - std_offset: 3600, - time_zone: "Europe/Copenhagen", - utc_offset: 3600, - year: 2015, - zone_abbr: "CEST" - } + assert DateTime.from_naive(ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) == + {:error, :incompatible_calendars} + end end - test "shift zone" do + test "shift_zone" do holocene_ndt = %NaiveDateTime{ calendar: Calendar.Holocene, year: 12018, @@ -1082,96 +998,3 @@ defmodule DateTimeTest do } end end - -defmodule TimeZoneDatabaseClientTest do - use ExUnit.Case, async: true - doctest TimeZoneDatabaseClient - - test "is leap second TimeZoneData test" do - assert TimeZoneDatabaseClient.is_leap_second(~N[1971-12-31 23:59:60], FakeTimeZoneDatabase) == - {:ok, false} - - assert TimeZoneDatabaseClient.is_leap_second(~N[2018-01-01 00:00:00], FakeTimeZoneDatabase) == - {:ok, false} - - assert TimeZoneDatabaseClient.is_leap_second(~N[1982-06-30 23:59:60], FakeTimeZoneDatabase) == - {:ok, true} - - assert TimeZoneDatabaseClient.is_leap_second(~N[2090-06-30 23:59:60], FakeTimeZoneDatabase) == - {:error, :outside_leap_second_data_range} - end - - test "leap seconds diff" do - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2090-06-30 23:59:60], - ~N[2007-06-30 12:00:00], - FakeTimeZoneDatabase - ) == {:error, :outside_leap_second_data_range} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2007-06-30 12:00:00], - ~N[2090-06-30 23:59:60], - FakeTimeZoneDatabase - ) == {:error, :outside_leap_second_data_range} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[1972-01-01 00:00:00], - ~N[1960-06-30 12:00:00], - FakeTimeZoneDatabase - ) == {:ok, 0} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[1972-07-01 00:00:00], - ~N[1960-06-30 12:00:00], - FakeTimeZoneDatabase - ) == {:ok, 1} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[1972-12-31 23:59:60], - ~N[1972-12-30 12:00:00], - FakeTimeZoneDatabase - ) == {:ok, 1} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[1972-06-30 23:59:60], - ~N[1960-06-30 12:00:00], - FakeTimeZoneDatabase - ) == {:ok, 1} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2015-07-01 00:00:01], - ~N[2015-06-30 23:59:59], - FakeTimeZoneDatabase - ) == {:ok, 1} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2015-06-30 23:59:60], - ~N[2015-06-30 23:59:59], - FakeTimeZoneDatabase - ) == {:ok, 1} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2015-06-30 23:59:60], - ~N[2015-06-30 23:59:60], - FakeTimeZoneDatabase - ) == {:ok, 0} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2016-12-31 23:59:60], - ~N[2015-06-30 23:59:60], - FakeTimeZoneDatabase - ) == {:ok, 1} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2016-12-31 23:59:60], - ~N[2015-06-30 23:59:58], - FakeTimeZoneDatabase - ) == {:ok, 2} - - assert TimeZoneDatabaseClient.leap_second_diff( - ~N[2017-01-01 00:59:59], - ~N[2015-06-30 23:59:58], - FakeTimeZoneDatabase - ) == {:ok, 2} - end -end diff --git a/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs b/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs index 675b2eb9f45..1da37ac043a 100644 --- a/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs +++ b/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs @@ -1,6 +1,5 @@ defmodule FakeTimeZoneDatabase do @behaviour TimeZoneDatabase - @tai_utc_second_difference_before_1972_06_30_23_59_60_utc 10 @time_zone_period_cph_summer_2018 %{ std_offset: 3600, @@ -142,113 +141,6 @@ defmodule FakeTimeZoneDatabase do {:error, :time_zone_not_found} end - @impl true - def is_leap_second(%{year: year}) when year < 1972 do - {:ok, false} - end - - def is_leap_second(naive_datetime) do - erl_datetime = naive_datetime |> NaiveDateTime.to_erl() - - leap_seconds_only = leap_seconds() |> Enum.map(fn {dt, _} -> dt end) - - case Enum.member?(leap_seconds_only, erl_datetime) do - true -> - {:ok, true} - - false -> - with :ok <- within_leap_second_data_range(naive_datetime) do - {:ok, false} - end - end - end - - @spec leap_second_diff(Calendar.naive_datetime(), Calendar.naive_datetime()) :: integer - @impl true - def leap_second_diff(datetime1, datetime2) do - with :ok <- within_leap_second_data_range(datetime1), - :ok <- within_leap_second_data_range(datetime2) do - tai_diff1 = latest_utc_tai_difference(datetime1) - tai_diff2 = latest_utc_tai_difference(datetime2) - {:ok, tai_diff1 - tai_diff2} - end - end - - # For a specific datetime (UTC) return the difference between UTC and TAI - @spec latest_utc_tai_difference(Calendar.naive_datetime()) :: integer - defp latest_utc_tai_difference(%{ - year: year, - month: month, - day: day, - hour: hour, - minute: minute, - second: second - }) - when {{year, month, day}, {hour, minute, second}} < {{1972, 6, 30}, {23, 59, 60}} do - @tai_utc_second_difference_before_1972_06_30_23_59_60_utc - end - - defp latest_utc_tai_difference(naive_datetime) do - {_, utc_tai_diff} = latest_leap_second_for_datetime(naive_datetime) - utc_tai_diff - end - - @spec latest_leap_second_for_datetime(Calendar.naive_datetime()) :: - {:calendar.datetime(), integer} - defp latest_leap_second_for_datetime(naive_datetime) do - p_erl_datetime = naive_datetime |> NaiveDateTime.to_erl() - - leap_seconds() - |> Enum.filter(fn {leap_second_only, _tai_diff} -> p_erl_datetime >= leap_second_only end) - |> List.last() - end - - @spec within_leap_second_data_range(Calendar.naive_datetime()) :: - :ok | {:error, :outside_leap_second_data_range} - defp within_leap_second_data_range(naive_datetime) do - if NaiveDateTime.to_erl(naive_datetime) > leap_second_data_valid_until() do - {:error, :outside_leap_second_data_range} - else - :ok - end - end - - defp leap_seconds do - [ - {{{1972, 6, 30}, {23, 59, 60}}, 11}, - {{{1972, 12, 31}, {23, 59, 60}}, 12}, - {{{1973, 12, 31}, {23, 59, 60}}, 13}, - {{{1974, 12, 31}, {23, 59, 60}}, 14}, - {{{1975, 12, 31}, {23, 59, 60}}, 15}, - {{{1976, 12, 31}, {23, 59, 60}}, 16}, - {{{1977, 12, 31}, {23, 59, 60}}, 17}, - {{{1978, 12, 31}, {23, 59, 60}}, 18}, - {{{1979, 12, 31}, {23, 59, 60}}, 19}, - {{{1981, 6, 30}, {23, 59, 60}}, 20}, - {{{1982, 6, 30}, {23, 59, 60}}, 21}, - {{{1983, 6, 30}, {23, 59, 60}}, 22}, - {{{1985, 6, 30}, {23, 59, 60}}, 23}, - {{{1987, 12, 31}, {23, 59, 60}}, 24}, - {{{1989, 12, 31}, {23, 59, 60}}, 25}, - {{{1990, 12, 31}, {23, 59, 60}}, 26}, - {{{1992, 6, 30}, {23, 59, 60}}, 27}, - {{{1993, 6, 30}, {23, 59, 60}}, 28}, - {{{1994, 6, 30}, {23, 59, 60}}, 29}, - {{{1995, 12, 31}, {23, 59, 60}}, 30}, - {{{1997, 6, 30}, {23, 59, 60}}, 31}, - {{{1998, 12, 31}, {23, 59, 60}}, 32}, - {{{2005, 12, 31}, {23, 59, 60}}, 33}, - {{{2008, 12, 31}, {23, 59, 60}}, 34}, - {{{2012, 6, 30}, {23, 59, 60}}, 35}, - {{{2015, 6, 30}, {23, 59, 60}}, 36}, - {{{2016, 12, 31}, {23, 59, 60}}, 37} - ] - end - - defp leap_second_data_valid_until do - {{2018, 12, 28}, {0, 0, 0}} - end - defp naive_datetime_from_iso_days(iso_days) do {year, month, day, hour, minute, second, microsecond} = Calendar.ISO.naive_datetime_from_iso_days(iso_days) From 455290b721d69db21ed0908e966689cfe9a26957 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 13 Nov 2018 11:22:18 +0100 Subject: [PATCH 03/10] Streamline time zone database API --- lib/elixir/docs.exs | 6 +- lib/elixir/lib/calendar.ex | 40 ++++++ lib/elixir/lib/calendar/datetime.ex | 134 +++++++++++------- lib/elixir/lib/calendar/time_zone_database.ex | 92 +++--------- lib/elixir/src/elixir.app.src | 2 +- lib/elixir/test/elixir/calendar_test.exs | 40 ++++++ .../calendar/fake_time_zone_database.exs | 14 +- 7 files changed, 190 insertions(+), 138 deletions(-) diff --git a/lib/elixir/docs.exs b/lib/elixir/docs.exs index a7ab34b9c47..49dc02a4b79 100644 --- a/lib/elixir/docs.exs +++ b/lib/elixir/docs.exs @@ -12,7 +12,6 @@ Base, Bitwise, Calendar, - Calendar.ISO, Date, DateTime, Exception, @@ -52,6 +51,11 @@ StringIO, System ], + "Calendar": [ + Calendar.ISO, + Calendar.TimeZoneDatabase, + Calendar.UTCOnlyTimeZoneDatabase + ], "Modules & Code": [ Code, Kernel.ParallelCompiler, diff --git a/lib/elixir/lib/calendar.ex b/lib/elixir/lib/calendar.ex index a156269c3c2..d00cd7ffdfb 100644 --- a/lib/elixir/lib/calendar.ex +++ b/lib/elixir/lib/calendar.ex @@ -90,6 +90,28 @@ defmodule Calendar do microsecond: microsecond } + @typedoc """ + Speficies the time zone database for calendar operations. + + Many functions in the `DateTime` module requires a time zone database. + By default, it uses the default time zone database returned by + `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" + datetimes and returns `{:error, :utc_only_time_zone_database}` + for any other time zone. + + Another time zone database, such as one originating from a package, + can be passed as argument or set globally, either via configuration: + + config :elixir, :time_zone_database, CustomTimeZoneDatabase + + or by calling `Calendar.put_time_zone_database/1`. + + See `Calendar.TimeZoneDatabase` for more information on custom + time zone databases. + """ + @type time_zone_database :: module() + @doc """ Returns how many days there are in the given year-month. """ @@ -236,4 +258,22 @@ defmodule Calendar do end def truncate(_, :second), do: {0, 0} + + @doc """ + Sets the currente time zone database. + """ + @doc since: "1.8.0" + @spec put_time_zone_database(time_zone_database()) :: :ok + def put_time_zone_database(database) do + Application.put_env(:elixir, :time_zone_database, database) + end + + @doc """ + Gets the current time zone database. + """ + @doc since: "1.8.0" + @spec get_time_zone_database() :: time_zone_database() + def get_time_zone_database() do + Application.get_env(:elixir, :time_zone_database, Calendar.UTCOnlyTimeZoneDatabase) + end end diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index 14517e2f471..130a22e513c 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -16,17 +16,21 @@ defmodule DateTime do and instead rely on the functions provided by this module as well as the ones in third-party calendar libraries. - ## Where are my functions? + ## Time zone database - You will notice this module only contains conversion - functions as well as functions that work on UTC. This - is because a proper `DateTime` implementation requires a - time zone database which currently is not provided as part - of Elixir. + Many functions in this module requires a time zone database. + By default, it uses the default time zone database returned by + `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" + datetimes and returns `{:error, :utc_only_time_zone_database}` + for any other time zone. - Such may be addressed in upcoming versions, meanwhile, - use third-party packages to provide `DateTime` building and - similar functionality with time zone backing. + Another time zone database, such as one originating from a package, + can be passed as argument or set globally, either via configuration: + + config :elixir, :time_zone_database, CustomTimeZoneDatabase + + or by calling `Calendar.put_time_zone_database/1`. """ @enforce_keys [:year, :month, :day, :hour, :minute, :second] ++ @@ -171,10 +175,11 @@ defmodule DateTime do @doc """ Converts the given `NaiveDateTime` to `DateTime`. - It expects a time zone to put the NaiveDateTime in. - - It only supports "Etc/UTC" as time zone if a `TimeZoneDatabase` - is not provided as a third argument. + It expects a time zone to put the `NaiveDateTime` in. + If the timezone is "Etc/UTC", it always succeeds. Otherwise, + the NaiveDateTime is checked against the time zone database + given as `time_zone_database`. See the "Time zone database" + section in the module documentation. ## Examples @@ -214,29 +219,28 @@ defmodule DateTime do @spec from_naive( NaiveDateTime.t(), Calendar.time_zone(), - TimeZoneDatabaseClient.tz_db_or_config() + Calendar.time_zone_database() ) :: {:ok, t} | {:ambiguous, t, t} | {:gap, t, t} - | {:error, :time_zone_not_found} - | {:error, :incompatible_calendars} - | {:error, :no_time_zone_database} + | {:error, + :incompatible_calendars | :time_zone_not_found | :utc_only_time_zone_database} - def from_naive(naive_datetime, time_zone, tz_db_or_config \\ :from_config) + def from_naive( + naive_datetime, + time_zone, + time_zone_database \\ Calendar.get_time_zone_database() + ) def from_naive(naive_datetime, "Etc/UTC", _) do utc_period = %{std_offset: 0, utc_offset: 0, zone_abbr: "UTC"} {:ok, from_naive_with_period(naive_datetime, "Etc/UTC", utc_period)} end - def from_naive(%{calendar: Calendar.ISO} = naive_datetime, time_zone, tz_db_or_config) do - case TimeZoneDatabaseClient.time_zone_periods_from_wall_datetime( - naive_datetime, - time_zone, - tz_db_or_config - ) do - {:single, period} -> + def from_naive(%{calendar: Calendar.ISO} = naive_datetime, time_zone, time_zone_database) do + case time_zone_database.time_zone_periods_from_wall_datetime(naive_datetime, time_zone) do + {:ok, period} -> {:ok, from_naive_with_period(naive_datetime, time_zone, period)} {:ambiguous, first_period, second_period} -> @@ -264,13 +268,13 @@ defmodule DateTime do end end - def from_naive(%{calendar: calendar} = naive_datetime, time_zone, tz_db_or_config) + def from_naive(%{calendar: calendar} = naive_datetime, time_zone, time_zone_database) when calendar != Calendar.ISO do # For non-ISO calendars, convert to ISO, create ISO DateTime, and then # convert to original calendar iso_result = with {:ok, in_iso} <- NaiveDateTime.convert(naive_datetime, Calendar.ISO) do - from_naive(in_iso, time_zone, tz_db_or_config) + from_naive(in_iso, time_zone, time_zone_database) end case iso_result do @@ -326,6 +330,10 @@ defmodule DateTime do Converts the given `NaiveDateTime` to `DateTime`. It expects a time zone to put the NaiveDateTime in. + If the timezone is "Etc/UTC", it always succeeds. Otherwise, + the NaiveDateTime is checked against the time zone database + given as `time_zone_database`. See the "Time zone database" + section in the module documentation. ## Examples @@ -340,28 +348,47 @@ defmodule DateTime do @spec from_naive!( NaiveDateTime.t(), Calendar.time_zone(), - TimeZoneDatabaseClient.tz_db_or_config() + Calendar.time_zone_database() ) :: t - def from_naive!(naive_datetime, time_zone, tz_db_or_config \\ :from_config) do - case from_naive(naive_datetime, time_zone, tz_db_or_config) do + def from_naive!( + naive_datetime, + time_zone, + time_zone_database \\ Calendar.get_time_zone_database() + ) do + case from_naive(naive_datetime, time_zone, time_zone_database) do {:ok, datetime} -> datetime + {:ambiguous, dt1, dt2} -> + raise ArgumentError, + "cannot convert #{inspect(naive_datetime)} to datetime because such " <> + "instant is ambiguous in time zone #{time_zone} as there is an overlap " <> + "between #{inspect(dt1)} and #{inspect(dt2)}" + + {:gap, dt1, dt2} -> + raise ArgumentError, + "cannot convert #{inspect(naive_datetime)} to datetime because such " <> + "instant does not exist in time zone #{time_zone} as there is a gap " <> + "between #{inspect(dt1)} and #{inspect(dt2)}" + {:error, reason} -> raise ArgumentError, - "cannot parse #{inspect(naive_datetime)} to datetime, reason: #{inspect(reason)}" + "cannot convert #{inspect(naive_datetime)} to datetime, reason: #{inspect(reason)}" end end @doc """ Changes the time zone of a `DateTime`. - Returns a `DateTime` for the same point in time, but instead at the time zone - provided. It assumes that `DateTime` is valid and exists in the given timezone - and calendar. + Returns a `DateTime` for the same point in time, but instead at + the time zone provided. It assumes that `DateTime` is valid and + exists in the given timezone and calendar. - Requires passing a `TimeZoneDatabase` as an argument or setting it with - `TimeZoneDatabaseClient.set_database/1`. + By default, it uses the default time_zone returned by + `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. + Another time zone database can be passed as argument or set globally. + See the "Time zone database" section in the module docs. ## Examples @@ -372,9 +399,9 @@ defmodule DateTime do """ @doc since: "1.8.0" - @spec shift_zone(t, Calendar.time_zone(), TimeZoneDatabaseClient.tz_db_or_config()) :: - {:ok, t} | {:error, :time_zone_not_found} | {:error, atom} - def shift_zone(datetime, time_zone, tz_db_or_config \\ :from_config) + @spec shift_zone(t, Calendar.time_zone(), Calendar.time_zone_database()) :: + {:ok, t} | {:error, :time_zone_not_found | :utc_only_time_zone_database} + def shift_zone(datetime, time_zone, time_zone_database) def shift_zone(%{time_zone: time_zone} = datetime, time_zone, _) do # When the desired time_zone is the same as the existing time_zone just return it unchanged. @@ -384,24 +411,20 @@ defmodule DateTime do def shift_zone( %{std_offset: std_offset, utc_offset: utc_offset} = datetime, time_zone, - tz_db_or_config + time_zone_database ) do - datetime_in_utc_iso_days = + iso_days_utc = datetime |> to_iso_days() |> apply_tz_offset(utc_offset + std_offset) - case TimeZoneDatabaseClient.time_zone_period_from_utc_iso_days( - datetime_in_utc_iso_days, - time_zone, - tz_db_or_config - ) do + case time_zone_database.time_zone_period_from_utc_iso_days(iso_days_utc, time_zone) do {:ok, %{std_offset: std_offset, utc_offset: utc_offset, zone_abbr: zone_abbr}} -> %{calendar: calendar, microsecond: {_, microsecond_precision}} = datetime {year, month, day, hour, minute, second, {microsecond_without_precision, _}} = - datetime_in_utc_iso_days - |> apply_tz_offset(-utc_offset - std_offset) + iso_days_utc + |> apply_tz_offset(-(utc_offset + std_offset)) |> calendar.naive_datetime_from_iso_days() datetime = %DateTime{ @@ -429,8 +452,11 @@ defmodule DateTime do @doc """ Returns the current datetime in the provided time zone. - Requires passing a `TimeZoneDatabase` as an argument or setting it with - `TimeZoneDatabaseClient.set_database/1`. + By default, it uses the default time_zone returned by + `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. + Another time zone database can be passed as argument or set globally. + See the "Time zone database" section in the module docs. ## Examples @@ -442,16 +468,16 @@ defmodule DateTime do """ @doc since: "1.8.0" - @spec now(Calendar.time_zone(), TimeZoneDatabaseClient.tz_db_or_config()) :: + @spec now(Calendar.time_zone(), Calendar.time_zone_database()) :: {:ok, t} | {:error, :time_zone_not_found} - def now(time_zone, tz_db_or_config \\ :from_config) + def now(time_zone, time_zone_database \\ Calendar.get_time_zone_database()) def now("Etc/UTC", _) do {:ok, utc_now()} end - def now(time_zone, tz_db_or_config) do - shift_zone(utc_now(), time_zone, tz_db_or_config) + def now(time_zone, time_zone_database) do + shift_zone(utc_now(), time_zone, time_zone_database) end @doc """ diff --git a/lib/elixir/lib/calendar/time_zone_database.ex b/lib/elixir/lib/calendar/time_zone_database.ex index 9545abb0c2c..f0d79fbd535 100644 --- a/lib/elixir/lib/calendar/time_zone_database.ex +++ b/lib/elixir/lib/calendar/time_zone_database.ex @@ -1,4 +1,4 @@ -defmodule TimeZoneDatabase do +defmodule Calendar.TimeZoneDatabase do @moduledoc """ This module defines a behaviour for providing time zone data. @@ -43,7 +43,8 @@ defmodule TimeZoneDatabase do `time_zone_period` for that point in time. """ @callback time_zone_period_from_utc_iso_days(Calendar.iso_days(), Calendar.time_zone()) :: - {:ok, time_zone_period} | {:error, :time_zone_not_found} + {:ok, time_zone_period} + | {:error, :time_zone_not_found | :utc_only_time_zone_database} @doc """ Possible time zone periods for a certain time zone and wall clock date and time. @@ -61,87 +62,28 @@ defmodule TimeZoneDatabase do and the `time_zone_period` is returned. """ @callback time_zone_periods_from_wall_datetime(Calendar.naive_datetime(), Calendar.time_zone()) :: - {:single, time_zone_period} + {:ok, time_zone_period} | {:ambiguous, time_zone_period, time_zone_period} | {:gap, {time_zone_period, time_zone_period_limit}, {time_zone_period, time_zone_period_limit}} - | {:error, :time_zone_not_found} + | {:error, :time_zone_not_found | :utc_only_time_zone_database} end -defmodule TimeZoneDatabaseClient do +defmodule Calendar.UTCOnlyTimeZoneDatabase do @moduledoc """ - Module used by Elixir for getting time zone data from a `TimeZoneDatabase` client. - """ - - @typedoc """ - Returns either a `TimeZoneDatabase.t()` or a `:from_config` atom. + Built-in time zone database that works only in Etc/UTC. - This can be passed to functions in e.g. the `DateTime` module. If `:from_config` - is passed, a `TimeZoneDatabase` set via the `set_database/1` function is used. + For all other time zones, it returns `{:error, :utc_only_time_zone_database}`. """ - @type tz_db_or_config :: TimeZoneDatabase.t() | :from_config + def time_zone_period_from_utc_iso_days(_, "Etc/UTC"), + do: {:ok, %{std_offset: 0, utc_offset: 0, zone_abbr: "UTC"}} - @doc """ - Function for setting a global time zone database. + def time_zone_period_from_utc_iso_days(_, _), + do: {:error, :utc_only_time_zone_database} - Takes a module that implements the TimeZoneDatabase behaviour. - """ - def set_database(time_zone_database) do - :elixir_config.put(:time_zone_database, time_zone_database) - end - - @doc false - @spec time_zone_periods_from_wall_datetime( - Calendar.naive_datetime(), - Calendar.time_zone(), - tz_db_or_config - ) :: - {:single, TimeZoneDatabase.time_zone_period()} - | {:ambiguous, TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period()} - | {:gap, - {TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period_limit()}, - {TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period_limit()}} - | {:error, :time_zone_not_found} - | {:error, :no_time_zone_database} - def time_zone_periods_from_wall_datetime( - %{calendar: Calendar.ISO} = naive_datetime, - time_zone, - tz_db_or_config - ) do - with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do - time_zone_database.time_zone_periods_from_wall_datetime(naive_datetime, time_zone) - end - end - - @doc false - @spec time_zone_period_from_utc_iso_days( - Calendar.iso_days(), - Calendar.time_zone(), - tz_db_or_config - ) :: - {:ok, TimeZoneDatabase.time_zone_period()} - | {:error, :time_zone_not_found} - | {:error, :no_time_zone_database} - def time_zone_period_from_utc_iso_days( - iso_days, - time_zone, - tz_db_or_config - ) do - with {:ok, time_zone_database} <- time_zone_database_from_tz_db_or_config(tz_db_or_config) do - time_zone_database.time_zone_period_from_utc_iso_days(iso_days, time_zone) - end - end - - @spec time_zone_database_from_tz_db_or_config(tz_db_or_config) :: - {:ok, TimeZoneDatabase.t()} | {:error, :no_time_zone_database} - defp time_zone_database_from_tz_db_or_config(:from_config) do - case :elixir_config.get(:time_zone_database, :no_time_zone_database) do - :no_time_zone_database -> {:error, :no_time_zone_database} - atom when is_atom(atom) -> {:ok, atom} - end - end - - defp time_zone_database_from_tz_db_or_config(time_zone_database) do - {:ok, time_zone_database} - end + def time_zone_periods_from_wall_datetime(_, "Etc/UTC"), + do: {:ok, %{std_offset: 0, utc_offset: 0, zone_abbr: "UTC"}} + + def time_zone_periods_from_wall_datetime(_, _), + do: {:error, :utc_only_time_zone_database} end diff --git a/lib/elixir/src/elixir.app.src b/lib/elixir/src/elixir.app.src index d45cc5ceeff..6b7ca7349af 100644 --- a/lib/elixir/src/elixir.app.src +++ b/lib/elixir/src/elixir.app.src @@ -5,5 +5,5 @@ {registered, [elixir_config, elixir_code_server]}, {applications, [kernel,stdlib,compiler]}, {mod, {elixir,[]}}, - {env, [{ansi_enabled, false}]} + {env, [{ansi_enabled, false}, {time_zone_database, 'Elixir.Calendar.UTCOnlyTimeZoneDatabase'}]} ]}. diff --git a/lib/elixir/test/elixir/calendar_test.exs b/lib/elixir/test/elixir/calendar_test.exs index bf6fb675c14..7ee8b1a8a8f 100644 --- a/lib/elixir/test/elixir/calendar_test.exs +++ b/lib/elixir/test/elixir/calendar_test.exs @@ -889,6 +889,32 @@ defmodule DateTimeTest do end describe "from_naive" do + test "uses default time zone database from config" do + Calendar.put_time_zone_database(FakeTimeZoneDatabase) + + assert DateTime.from_naive( + ~N[2018-07-01 12:34:25.123456], + "Europe/Copenhagen", + FakeTimeZoneDatabase + ) == + {:ok, + %DateTime{ + day: 1, + hour: 12, + microsecond: {123_456, 6}, + minute: 34, + month: 7, + second: 25, + std_offset: 3600, + time_zone: "Europe/Copenhagen", + utc_offset: 3600, + year: 2018, + zone_abbr: "CEST" + }} + after + Calendar.put_time_zone_database(Calendar.UTCOnlyTimeZoneDatabase) + end + test "with compatible calendar on unambiguous wall clock" do holocene_ndt = %NaiveDateTime{ calendar: Calendar.Holocene, @@ -965,6 +991,20 @@ defmodule DateTimeTest do end end + describe "from_naive!" do + test "raises on ambiguous wall clock" do + assert_raise ArgumentError, ~r"ambiguous", fn -> + DateTime.from_naive!(~N[2018-10-28 02:30:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + end + end + + test "raises on gap" do + assert_raise ArgumentError, ~r"gap", fn -> + DateTime.from_naive!(~N[2019-03-31 02:30:00], "Europe/Copenhagen", FakeTimeZoneDatabase) + end + end + end + test "shift_zone" do holocene_ndt = %NaiveDateTime{ calendar: Calendar.Holocene, diff --git a/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs b/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs index 1da37ac043a..f657b5e266a 100644 --- a/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs +++ b/lib/elixir/test/elixir/fixtures/calendar/fake_time_zone_database.exs @@ -1,5 +1,5 @@ defmodule FakeTimeZoneDatabase do - @behaviour TimeZoneDatabase + @behaviour Calendar.TimeZoneDatabase @time_zone_period_cph_summer_2018 %{ std_offset: 3600, @@ -34,7 +34,7 @@ defmodule FakeTimeZoneDatabase do end @spec time_zone_periods_from_wall_datetime(Calendar.naive_datetime(), Calendar.time_zone()) :: - {:single, TimeZoneDatabase.time_zone_period()} + {:ok, TimeZoneDatabase.time_zone_period()} | {:ambiguous, TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period()} | {:gap, {TimeZoneDatabase.time_zone_period(), TimeZoneDatabase.time_zone_period_limit()}, @@ -100,25 +100,25 @@ defmodule FakeTimeZoneDatabase do defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) when erl_datetime >= {{2018, 3, 25}, {3, 0, 0}} and erl_datetime < {{2018, 10, 28}, {3, 0, 0}} do - {:single, @time_zone_period_cph_summer_2018} + {:ok, @time_zone_period_cph_summer_2018} end defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) when erl_datetime >= {{2018, 10, 28}, {2, 0, 0}} and erl_datetime < {{2019, 3, 31}, {2, 0, 0}} do - {:single, @time_zone_period_cph_winter_2018_2019} + {:ok, @time_zone_period_cph_winter_2018_2019} end defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) when erl_datetime >= {{2019, 3, 31}, {3, 0, 0}} and erl_datetime < {{2019, 10, 27}, {3, 0, 0}} do - {:single, @time_zone_period_cph_summer_2019} + {:ok, @time_zone_period_cph_summer_2019} end defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) when erl_datetime >= {{2015, 3, 29}, {3, 0, 0}} and erl_datetime < {{2015, 10, 25}, {3, 0, 0}} do - {:single, + {:ok, %{ std_offset: 3600, utc_offset: 3600, @@ -129,7 +129,7 @@ defmodule FakeTimeZoneDatabase do defp time_zone_periods_from_wall("Europe/Copenhagen", erl_datetime) when erl_datetime >= {{2090, 3, 26}, {3, 0, 0}} and erl_datetime < {{2090, 10, 29}, {3, 0, 0}} do - {:single, + {:ok, %{ std_offset: 3600, utc_offset: 3600, From bf343b3ad68da9164e09c9ba87034636072ed1c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 13 Nov 2018 11:47:54 +0100 Subject: [PATCH 04/10] Update datetime.ex --- lib/elixir/lib/calendar/datetime.ex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index 130a22e513c..c47da273725 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -469,7 +469,7 @@ defmodule DateTime do """ @doc since: "1.8.0" @spec now(Calendar.time_zone(), Calendar.time_zone_database()) :: - {:ok, t} | {:error, :time_zone_not_found} + {:ok, t} | {:error, :time_zone_not_found | :utc_only_time_zone_database} def now(time_zone, time_zone_database \\ Calendar.get_time_zone_database()) def now("Etc/UTC", _) do From bbbc4502d805379be85fef3435b6f220e2bda65e Mon Sep 17 00:00:00 2001 From: Fernando Tapia Rico Date: Tue, 13 Nov 2018 12:02:24 +0100 Subject: [PATCH 05/10] Fix typo Co-Authored-By: josevalim --- lib/elixir/lib/calendar.ex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/elixir/lib/calendar.ex b/lib/elixir/lib/calendar.ex index d00cd7ffdfb..fdac86999ff 100644 --- a/lib/elixir/lib/calendar.ex +++ b/lib/elixir/lib/calendar.ex @@ -91,7 +91,7 @@ defmodule Calendar do } @typedoc """ - Speficies the time zone database for calendar operations. + Specifies the time zone database for calendar operations. Many functions in the `DateTime` module requires a time zone database. By default, it uses the default time zone database returned by From 2dafa9fa85409df446e53623510e87b454ac7e33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 13 Nov 2018 12:22:42 +0100 Subject: [PATCH 06/10] Update datetime.ex --- lib/elixir/lib/calendar/datetime.ex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index c47da273725..ff1661faba9 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -384,7 +384,7 @@ defmodule DateTime do the time zone provided. It assumes that `DateTime` is valid and exists in the given timezone and calendar. - By default, it uses the default time_zone returned by + By default, it uses the default time zone database returned by `Calendar.get_time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. Another time zone database can be passed as argument or set globally. From cc9d7aa319b1161937e1ec18b1583ccfefb780f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 13 Nov 2018 12:28:21 +0100 Subject: [PATCH 07/10] Have default time_zone_database in shift_zone --- lib/elixir/lib/calendar/datetime.ex | 2 +- lib/elixir/test/elixir/calendar_test.exs | 85 +++++++++++++++--------- 2 files changed, 56 insertions(+), 31 deletions(-) diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index ff1661faba9..dc42dd1810e 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -401,7 +401,7 @@ defmodule DateTime do @doc since: "1.8.0" @spec shift_zone(t, Calendar.time_zone(), Calendar.time_zone_database()) :: {:ok, t} | {:error, :time_zone_not_found | :utc_only_time_zone_database} - def shift_zone(datetime, time_zone, time_zone_database) + def shift_zone(datetime, time_zone, time_zone_database \\ Calendar.get_time_zone_database()) def shift_zone(%{time_zone: time_zone} = datetime, time_zone, _) do # When the desired time_zone is the same as the existing time_zone just return it unchanged. diff --git a/lib/elixir/test/elixir/calendar_test.exs b/lib/elixir/test/elixir/calendar_test.exs index 7ee8b1a8a8f..f8bdc8f6311 100644 --- a/lib/elixir/test/elixir/calendar_test.exs +++ b/lib/elixir/test/elixir/calendar_test.exs @@ -1005,36 +1005,61 @@ defmodule DateTimeTest do end end - test "shift_zone" do - holocene_ndt = %NaiveDateTime{ - calendar: Calendar.Holocene, - year: 12018, - month: 7, - day: 1, - hour: 12, - minute: 34, - second: 25, - microsecond: {123_456, 6} - } + describe "shift_zone" do + test "with compatible calendar" do + holocene_ndt = %NaiveDateTime{ + calendar: Calendar.Holocene, + year: 12018, + month: 7, + day: 1, + hour: 12, + minute: 34, + second: 25, + microsecond: {123_456, 6} + } + + {:ok, holocene_dt} = + DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) + + {:ok, dt} = DateTime.shift_zone(holocene_dt, "America/Los_Angeles", FakeTimeZoneDatabase) + + assert dt == %DateTime{ + calendar: Calendar.Holocene, + day: 1, + hour: 3, + microsecond: {123_456, 6}, + minute: 34, + month: 7, + second: 25, + std_offset: 3600, + time_zone: "America/Los_Angeles", + utc_offset: -28800, + year: 12018, + zone_abbr: "PDT" + } + end + + test "uses default time zone database from config" do + Calendar.put_time_zone_database(FakeTimeZoneDatabase) - {:ok, holocene_dt} = - DateTime.from_naive(holocene_ndt, "Europe/Copenhagen", FakeTimeZoneDatabase) - - {:ok, dt} = DateTime.shift_zone(holocene_dt, "America/Los_Angeles", FakeTimeZoneDatabase) - - assert dt == %DateTime{ - calendar: Calendar.Holocene, - day: 1, - hour: 3, - microsecond: {123_456, 6}, - minute: 34, - month: 7, - second: 25, - std_offset: 3600, - time_zone: "America/Los_Angeles", - utc_offset: -28800, - year: 12018, - zone_abbr: "PDT" - } + {:ok, dt} = DateTime.from_naive(~N[2018-07-01 12:34:25.123456], "Europe/Copenhagen") + {:ok, dt} = DateTime.shift_zone(dt, "America/Los_Angeles") + + assert dt == %DateTime{ + day: 1, + hour: 3, + microsecond: {123_456, 6}, + minute: 34, + month: 7, + second: 25, + std_offset: 3600, + time_zone: "America/Los_Angeles", + utc_offset: -28800, + year: 2018, + zone_abbr: "PDT" + } + after + Calendar.put_time_zone_database(Calendar.UTCOnlyTimeZoneDatabase) + end end end From 8638fa006b382401874a82fb4f931c5c50effa4b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 13 Nov 2018 14:20:31 +0100 Subject: [PATCH 08/10] More feedback, rename function --- lib/elixir/lib/calendar.ex | 8 ++++---- lib/elixir/lib/calendar/datetime.ex | 24 ++++++++++++------------ 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/lib/elixir/lib/calendar.ex b/lib/elixir/lib/calendar.ex index fdac86999ff..02894902c55 100644 --- a/lib/elixir/lib/calendar.ex +++ b/lib/elixir/lib/calendar.ex @@ -93,15 +93,15 @@ defmodule Calendar do @typedoc """ Specifies the time zone database for calendar operations. - Many functions in the `DateTime` module requires a time zone database. + Many functions in the `DateTime` module require a time zone database. By default, it uses the default time zone database returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes and returns `{:error, :utc_only_time_zone_database}` for any other time zone. - Another time zone database, such as one originating from a package, - can be passed as argument or set globally, either via configuration: + Other time zone databases (including ones provided by packages) + can be configure as default either via configuration: config :elixir, :time_zone_database, CustomTimeZoneDatabase diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index dc42dd1810e..a0acc2c3544 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -18,15 +18,15 @@ defmodule DateTime do ## Time zone database - Many functions in this module requires a time zone database. + Many functions in this module require a time zone database. By default, it uses the default time zone database returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes and returns `{:error, :utc_only_time_zone_database}` for any other time zone. - Another time zone database, such as one originating from a package, - can be passed as argument or set globally, either via configuration: + Other time zone databases (including ones provided by packages) + can be configure as default either via configuration: config :elixir, :time_zone_database, CustomTimeZoneDatabase @@ -230,7 +230,7 @@ defmodule DateTime do def from_naive( naive_datetime, time_zone, - time_zone_database \\ Calendar.get_time_zone_database() + time_zone_database \\ Calendar.time_zone_database() ) def from_naive(naive_datetime, "Etc/UTC", _) do @@ -353,7 +353,7 @@ defmodule DateTime do def from_naive!( naive_datetime, time_zone, - time_zone_database \\ Calendar.get_time_zone_database() + time_zone_database \\ Calendar.time_zone_database() ) do case from_naive(naive_datetime, time_zone, time_zone_database) do {:ok, datetime} -> @@ -385,9 +385,9 @@ defmodule DateTime do exists in the given timezone and calendar. By default, it uses the default time zone database returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. - Another time zone database can be passed as argument or set globally. + Other time zone databases can be passed as argument or set globally. See the "Time zone database" section in the module docs. ## Examples @@ -401,7 +401,7 @@ defmodule DateTime do @doc since: "1.8.0" @spec shift_zone(t, Calendar.time_zone(), Calendar.time_zone_database()) :: {:ok, t} | {:error, :time_zone_not_found | :utc_only_time_zone_database} - def shift_zone(datetime, time_zone, time_zone_database \\ Calendar.get_time_zone_database()) + def shift_zone(datetime, time_zone, time_zone_database \\ Calendar.time_zone_database()) def shift_zone(%{time_zone: time_zone} = datetime, time_zone, _) do # When the desired time_zone is the same as the existing time_zone just return it unchanged. @@ -453,9 +453,9 @@ defmodule DateTime do Returns the current datetime in the provided time zone. By default, it uses the default time_zone returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. - Another time zone database can be passed as argument or set globally. + Other time zone databases can be passed as argument or set globally. See the "Time zone database" section in the module docs. ## Examples @@ -470,7 +470,7 @@ defmodule DateTime do @doc since: "1.8.0" @spec now(Calendar.time_zone(), Calendar.time_zone_database()) :: {:ok, t} | {:error, :time_zone_not_found | :utc_only_time_zone_database} - def now(time_zone, time_zone_database \\ Calendar.get_time_zone_database()) + def now(time_zone, time_zone_database \\ Calendar.time_zone_database()) def now("Etc/UTC", _) do {:ok, utc_now()} From 2450441e92c7285c4e7217f37ce6d578e6076df8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 13 Nov 2018 14:31:58 +0100 Subject: [PATCH 09/10] Rollback to get_time_zone_database --- lib/elixir/lib/calendar.ex | 2 +- lib/elixir/lib/calendar/datetime.ex | 22 +++++++++++----------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/elixir/lib/calendar.ex b/lib/elixir/lib/calendar.ex index 02894902c55..c2a334a54ef 100644 --- a/lib/elixir/lib/calendar.ex +++ b/lib/elixir/lib/calendar.ex @@ -95,7 +95,7 @@ defmodule Calendar do Many functions in the `DateTime` module require a time zone database. By default, it uses the default time zone database returned by - `Calendar.time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes and returns `{:error, :utc_only_time_zone_database}` for any other time zone. diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index a0acc2c3544..36ffa19a1e6 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -20,7 +20,7 @@ defmodule DateTime do Many functions in this module require a time zone database. By default, it uses the default time zone database returned by - `Calendar.time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes and returns `{:error, :utc_only_time_zone_database}` for any other time zone. @@ -219,7 +219,7 @@ defmodule DateTime do @spec from_naive( NaiveDateTime.t(), Calendar.time_zone(), - Calendar.time_zone_database() + Calendar.get_time_zone_database() ) :: {:ok, t} | {:ambiguous, t, t} @@ -230,7 +230,7 @@ defmodule DateTime do def from_naive( naive_datetime, time_zone, - time_zone_database \\ Calendar.time_zone_database() + time_zone_database \\ Calendar.get_time_zone_database() ) def from_naive(naive_datetime, "Etc/UTC", _) do @@ -348,12 +348,12 @@ defmodule DateTime do @spec from_naive!( NaiveDateTime.t(), Calendar.time_zone(), - Calendar.time_zone_database() + Calendar.get_time_zone_database() ) :: t def from_naive!( naive_datetime, time_zone, - time_zone_database \\ Calendar.time_zone_database() + time_zone_database \\ Calendar.get_time_zone_database() ) do case from_naive(naive_datetime, time_zone, time_zone_database) do {:ok, datetime} -> @@ -385,7 +385,7 @@ defmodule DateTime do exists in the given timezone and calendar. By default, it uses the default time zone database returned by - `Calendar.time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. Other time zone databases can be passed as argument or set globally. See the "Time zone database" section in the module docs. @@ -399,9 +399,9 @@ defmodule DateTime do """ @doc since: "1.8.0" - @spec shift_zone(t, Calendar.time_zone(), Calendar.time_zone_database()) :: + @spec shift_zone(t, Calendar.time_zone(), Calendar.get_time_zone_database()) :: {:ok, t} | {:error, :time_zone_not_found | :utc_only_time_zone_database} - def shift_zone(datetime, time_zone, time_zone_database \\ Calendar.time_zone_database()) + def shift_zone(datetime, time_zone, time_zone_database \\ Calendar.get_time_zone_database()) def shift_zone(%{time_zone: time_zone} = datetime, time_zone, _) do # When the desired time_zone is the same as the existing time_zone just return it unchanged. @@ -453,7 +453,7 @@ defmodule DateTime do Returns the current datetime in the provided time zone. By default, it uses the default time_zone returned by - `Calendar.time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/1`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. Other time zone databases can be passed as argument or set globally. See the "Time zone database" section in the module docs. @@ -468,9 +468,9 @@ defmodule DateTime do """ @doc since: "1.8.0" - @spec now(Calendar.time_zone(), Calendar.time_zone_database()) :: + @spec now(Calendar.time_zone(), Calendar.get_time_zone_database()) :: {:ok, t} | {:error, :time_zone_not_found | :utc_only_time_zone_database} - def now(time_zone, time_zone_database \\ Calendar.time_zone_database()) + def now(time_zone, time_zone_database \\ Calendar.get_time_zone_database()) def now("Etc/UTC", _) do {:ok, utc_now()} From debd47522637a73993cb0df5185de2fd7863995a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 13 Nov 2018 14:41:46 +0100 Subject: [PATCH 10/10] Fix arity --- lib/elixir/lib/calendar.ex | 2 +- lib/elixir/lib/calendar/datetime.ex | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/elixir/lib/calendar.ex b/lib/elixir/lib/calendar.ex index c2a334a54ef..5dbf330c7c9 100644 --- a/lib/elixir/lib/calendar.ex +++ b/lib/elixir/lib/calendar.ex @@ -95,7 +95,7 @@ defmodule Calendar do Many functions in the `DateTime` module require a time zone database. By default, it uses the default time zone database returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/0`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes and returns `{:error, :utc_only_time_zone_database}` for any other time zone. diff --git a/lib/elixir/lib/calendar/datetime.ex b/lib/elixir/lib/calendar/datetime.ex index 36ffa19a1e6..c33b16a5711 100644 --- a/lib/elixir/lib/calendar/datetime.ex +++ b/lib/elixir/lib/calendar/datetime.ex @@ -20,7 +20,7 @@ defmodule DateTime do Many functions in this module require a time zone database. By default, it uses the default time zone database returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/0`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes and returns `{:error, :utc_only_time_zone_database}` for any other time zone. @@ -385,7 +385,7 @@ defmodule DateTime do exists in the given timezone and calendar. By default, it uses the default time zone database returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/0`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. Other time zone databases can be passed as argument or set globally. See the "Time zone database" section in the module docs. @@ -453,7 +453,7 @@ defmodule DateTime do Returns the current datetime in the provided time zone. By default, it uses the default time_zone returned by - `Calendar.get_time_zone_database/1`, which defaults to + `Calendar.get_time_zone_database/0`, which defaults to `Calendar.UTCOnlyTimeZoneDatabase` which only handles "Etc/UTC" datetimes. Other time zone databases can be passed as argument or set globally. See the "Time zone database" section in the module docs.