(*---------------------------------------------------------------------------
   Copyright (c) 2015 The ptime programmers. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

open B0_testing
open Testing_ptime

let stamp_of_date_time ?__POS__ d =
  Ptime.of_date_time d |> Test.get_some ?__POS__

let valid_date_time ?__POS__ d =
  Test.holds ?__POS__ (Option.is_some (Ptime.of_date_time d))

let wrong_date_time ?__POS__ d =
  Test.holds ?__POS__ (Option.is_none (Ptime.of_date_time d))

let test_time_bounds () =
  Test.test "date-time time field bounds" @@ fun () ->
  let min_date = Ptime.to_date Ptime.min in
  let min_utc t = min_date, (t, 0) in
  (* Check hour bounds *)
  wrong_date_time ~__POS__ (min_utc (-2, 00, 00));
  wrong_date_time ~__POS__ (min_utc (-1, 00, 00));
  valid_date_time ~__POS__ (min_utc (00, 00, 00));
  valid_date_time ~__POS__ (min_utc (01, 00, 00));
  valid_date_time ~__POS__ (min_utc (23, 00, 00));
  wrong_date_time ~__POS__ (min_utc (24, 00, 00));
  (* Check minute bounds *)
  wrong_date_time ~__POS__ (min_utc (00, -2, 00));
  wrong_date_time ~__POS__ (min_utc (00, -1, 00));
  valid_date_time ~__POS__ (min_utc (00, 00, 00));
  valid_date_time ~__POS__ (min_utc (00, 01, 00));
  valid_date_time ~__POS__ (min_utc (00, 59, 00));
  wrong_date_time ~__POS__ (min_utc (00, 60, 00));
  (* Check second bounds *)
  wrong_date_time ~__POS__ (min_utc (00, 00, -2));
  wrong_date_time ~__POS__ (min_utc (00, 00, -1));
  valid_date_time ~__POS__ (min_utc (00, 00, 00));
  valid_date_time ~__POS__ (min_utc (00, 00, 01));
  valid_date_time ~__POS__ (min_utc (00, 00, 59));
  valid_date_time ~__POS__ (min_utc (00, 00, 60));
  wrong_date_time ~__POS__ (min_utc (00, 00, 61));
  ()

let test_tz () =
  Test.test "testing date-time time zone calculations" @@ fun () ->
  (* Timestamps with tz offsets around Ptime.{max,min} *)
  wrong_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +1));
  valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +0));
  valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), -1));
  wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 59), -1));
  wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +0));
  valid_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +1));
  (* Convert time zones *)
  let nyc_tz = -4 * 3600 in
  let cam_tz = +1 * 3600 in
  let lau_tz = +2 * 3600 in
  let new_york  = ((2015, 06, 27), ((18, 30, 01), nyc_tz)) in
  let cambridge = ((2015, 06, 27), ((23, 30, 01), cam_tz)) in
  let lausanne  = ((2015, 06, 28), ((00, 30, 01), lau_tz)) in
  let nyc_stamp = stamp_of_date_time new_york in
  let cam_stamp = stamp_of_date_time cambridge in
  let lau_stamp = stamp_of_date_time lausanne in
  T.stamp ~__POS__ nyc_stamp cam_stamp;
  T.stamp ~__POS__ cam_stamp lau_stamp;
  T.date_time ~__POS__
    (Ptime.to_date_time ~tz_offset_s:nyc_tz nyc_stamp) new_york;
  T.date_time ~__POS__
    (Ptime.to_date_time ~tz_offset_s:cam_tz nyc_stamp) cambridge;
  T.date_time ~__POS__
    (Ptime.to_date_time ~tz_offset_s:lau_tz nyc_stamp) lausanne;
  ()

let test_subsecond () =
  Test.test "subsecond stamp to date-time" @@ fun () ->
  let span_of_d_ps ?__POS__ s =
    Ptime.Span.of_d_ps s |> Test.get_some ?__POS__
  in
  let add, sub =
    let add t ps = Ptime.(add_span t (span_of_d_ps (0, ps))) |> Test.get_some in
    let sub t ps = Ptime.(sub_span t (span_of_d_ps (0, ps))) |> Test.get_some in
    add, sub
  in
  let b0 = sub Ptime.epoch 750_000_000_000L in
  let b1 = sub Ptime.epoch 500_000_000_000L in
  let b2 = sub Ptime.epoch 250_000_000_000L in
  let b = (1969, 12, 31), ((23, 59, 59), +0) in
  T.date_time ~__POS__ b (Ptime.to_date_time b0);
  T.date_time ~__POS__ b (Ptime.to_date_time b1);
  T.date_time ~__POS__ b (Ptime.to_date_time b2);
  let a0 = add Ptime.epoch 750_000_000_000L in
  let a1 = add Ptime.epoch 500_000_000_000L in
  let a2 = add Ptime.epoch 250_000_000_000L in
  let a = (1970, 01, 01), ((00, 00, 00), +0) in
  T.date_time ~__POS__ a (Ptime.to_date_time a0);
  T.date_time ~__POS__ a (Ptime.to_date_time a1);
  T.date_time ~__POS__ a (Ptime.to_date_time a2);
  ()

let test_leap_sec () =
  Test.test "testing leap second date-times" @@ fun () ->
  let after_leap_sec = (1999, 01, 01), ((00, 00, 00), 0) in
  let t0 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 59), 0)) in
  let t1 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 60), 0)) in
  let t2 = stamp_of_date_time after_leap_sec in
  T.stamp ~__POS__ t1 t2
      (* leap sec is represented by second that comes after *);
  T.stamp_option ~__POS__ (Some t1) Ptime.(add_span t0 (Span.of_int_s 1));
  T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t1);
  T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t2);
  T.span ~__POS__ (Ptime.diff t2 t0) (Ptime.Span.of_int_s 1);
  T.span ~__POS__ (Ptime.diff t1 t0) (Ptime.Span.of_int_s 1);
  T.span ~__POS__ (Ptime.diff t2 t1) (Ptime.Span.of_int_s 0);
  ()

let test_stamp_trips () =
  Test.test "random stamps to date-time round trips" @@ fun () ->
  let stamp_of_posix_s s = Ptime.of_float_s s |> Test.get_some in
  let trip ?tz_offset_s t =
    let back = stamp_of_posix_s (floor (Ptime.to_float_s t)) in
    let trip = stamp_of_date_time (Ptime.to_date_time ?tz_offset_s t) in
    T.stamp ~__POS__ back trip
  in
  for i = 1 to Rand.loop_len () do
    trip ~tz_offset_s:0 (* UTC *) (Rand.float_stamp ());
    trip ~tz_offset_s:(Rand.tz_offset_s ()) (Rand.float_stamp ())
  done

let test_round_trips () =
  Test.test "random valid date-times to stamp round trips" @@ fun () ->
  let is_leap_sec = function
  | (_, _, _), ((_, _, 60), _) -> true
  | _ -> false
  in
  let rec rand_date_time_stamp () = (* biased *)
    let date = Rand.date () in
    let time = Rand.time () in
    let tz = Rand.tz_offset_s () in
    let dt = (date, (time, tz)) in
    match Ptime.of_date_time dt with
    | Some _ -> dt
    | None ->
        let dt = date, (time, 0) (* try in UTC *) in
        begin match Ptime.of_date_time dt with
        | None -> rand_date_time_stamp () (* start again *)
        | Some _ -> dt
        end
  in
  let add_posix_s =
    let span s = Ptime.Span.of_float_s s |> Test.get_some in
    let add_posix_s t s = Ptime.(add_span t (span s)) |> Test.get_some in
    add_posix_s
  in
  for i = 1 to Rand.loop_len () do
    let (_, (_, tz_offset_s) as dt) = rand_date_time_stamp () in
    let stamp = stamp_of_date_time dt in
    if not (is_leap_sec dt)
    then begin
      let ((y, _, _), _ as dt') = Ptime.to_date_time ~tz_offset_s stamp in
      assert (Ptime.to_year ~tz_offset_s stamp = y);
      T.date_time ~__POS__ dt dt'
    end
    else begin
      (* Verify we map the leap sec on the the second after. *)
      let before_leap_dt = match dt with
      | date, ((hh, ss, 60), tz) -> date, ((hh, ss, 59), tz)
      | _ -> assert false
      in
      let stamp' = add_posix_s (stamp_of_date_time before_leap_dt) 1. in
      T.stamp ~__POS__ stamp stamp'
    end
  done;
  ()

let test_weekday () =
  Test.test "Ptime.{weekday_num,weekday}" @@ fun () ->
  let module Weekday = struct
    type t = Ptime.weekday
    let equal = ( = )
    let pp ppf v = Format.pp_print_string ppf @@ match v with
      | `Mon -> "`Mon" | `Tue -> "`Tue" | `Wed -> "`Wed" | `Thu -> "`Thu"
      | `Fri -> "`Fri" | `Sat -> "`Sat" | `Sun -> "`Sun"
  end
  in
  let weekday ?__POS__ = Test.eq ?__POS__ (module Weekday) in
  let eq ?__POS__ ?tz_offset_s c wday =
    let s = stamp_of_date_time (c, ((0, 0, 0), 0)) in
    weekday ?__POS__ (Ptime.weekday ?tz_offset_s s) wday
  in
  eq ~__POS__ (1970, 01, 01) `Thu;
  eq ~__POS__ ~tz_offset_s:(-1) (1970, 01, 01) `Wed;
  eq ~__POS__ ~tz_offset_s:86400 (1970, 01, 01) `Fri;
  eq ~__POS__ (1871, 03, 18) `Sat;
  eq ~__POS__ ~tz_offset_s:(-1) (1871, 03, 18) `Fri;
  eq ~__POS__ ~tz_offset_s:86400 (1871, 03, 18) `Sun;
  eq ~__POS__ (1995, 09, 12) `Tue;
  eq ~__POS__ ~tz_offset_s:(-1) (1995, 09, 12) `Mon;
  eq ~__POS__ ~tz_offset_s:86400 (1995, 09, 12) `Wed;
  eq ~__POS__ ~tz_offset_s:172800 (1995, 09, 12) `Thu;
  ()

let tests () =
  test_time_bounds ();
  test_tz ();
  test_subsecond ();
  test_leap_sec ();
  test_stamp_trips ();
  test_round_trips ();
  test_weekday ();
  ()