open! Core
open! Import
module Time = Core.Time_float

include (
  Time :
    (module type of struct
      include Time
    end
    with module Map := Time.Map
    with module Set := Time.Set
   (* We disable deprecations because we need to elide deprecated
                          submodules. *)
   [@ocaml.warning "-3"]))

module T = Time_functor.Make (Time) (Time)
include Diffable.Atomic.Make (T)

(* Previous versions rendered hash-based containers using float serialization rather than
   time serialization, so when reading hash-based containers in we accept either
   serialization. *)
include Hashable.Make_binable (struct
  type t = Time.t [@@deriving bin_io, compare, hash]

  let sexp_of_t = T.sexp_of_t

  let t_of_sexp sexp =
    match Float.t_of_sexp sexp with
    | float -> Time.of_span_since_epoch (Time.Span.of_sec float)
    | exception _ -> T.t_of_sexp sexp
  ;;
end)

module Span = struct
  include Time.Span

  let arg_type = T.Span.arg_type
end

module Ofday = struct
  include Time.Ofday
  module Zoned = T.Ofday.Zoned

  let now = T.Ofday.now
  let arg_type = T.Ofday.arg_type
end

module Zone = struct
  include Time.Zone

  include (
    T.Zone :
      module type of struct
        include T.Zone
      end
      with module Index := T.Zone.Index
      with type t := T.Zone.t)
end

module Stable = struct
  module V1 = struct
    (* There is no simple, pristine implementation of "stable time", and in fact
       [Time.Stable.V1] has always called out to "unstable" string conversions.
       For a complicated "stable" story like this, we rely on comprehensive tests
       of stability; see [lib/core/test/src/test_time.ml]. *)
    include T
    include Diffable.Atomic.Make (T)

    let stable_witness : t Stable_witness.t = Stable_witness.assert_stable

    module Map = struct
      include Map

      let stable_witness _ = Stable_witness.assert_stable
    end

    module Set = struct
      include Set

      let stable_witness = Stable_witness.assert_stable
    end
  end

  module With_utc_sexp = struct
    module V1 = struct
      module C = struct
        include (
          V1 : module type of V1 with module Map := V1.Map and module Set := V1.Set)

        let sexp_of_t t = sexp_of_t_abs t ~zone:Zone.utc
      end

      include C
      module Map = Map.Make_binable_using_comparator (C)
      module Set = Set.Make_binable_using_comparator (C)
    end

    module V2 = struct
      module C = struct
        include Time.Stable.With_utc_sexp.V2

        type comparator_witness = T.comparator_witness

        let comparator = T.comparator
      end

      include C
      include Comparable.Stable.V1.Make (C)
    end
  end

  module With_t_of_sexp_abs = struct
    module V1 = struct
      include (V1 : module type of V1 with module Map := V1.Map and module Set := V1.Set)

      let t_of_sexp = t_of_sexp_abs
    end
  end

  module Span = Time.Stable.Span

  module Ofday = struct
    include Time.Stable.Ofday

    module Zoned = struct
      module V1 = struct
        open T.Ofday.Zoned

        type nonrec t = t [@@deriving hash]

        let compare = With_nonchronological_compare.compare

        module Bin_repr = struct
          type t =
            { ofday : Time.Stable.Ofday.V1.t
            ; zone : Timezone.Stable.V1.t
            }
          [@@deriving bin_io, stable_witness]
        end

        let to_binable t : Bin_repr.t = { ofday = ofday t; zone = zone t }
        let of_binable (repr : Bin_repr.t) = create repr.ofday repr.zone

        include
          Binable.Stable.Of_binable.V1 [@alert "-legacy"]
            (Bin_repr)
            (struct
              type nonrec t = t

              let to_binable = to_binable
              let of_binable = of_binable
            end)

        let stable_witness =
          Stable_witness.of_serializable
            [%stable_witness: Bin_repr.t]
            of_binable
            to_binable
        ;;

        let%expect_test _ =
          print_endline [%bin_digest: t];
          [%expect {| 490573c3397b4fe37e8ade0086fb4759 |}]
        ;;

        type sexp_repr = Time.Stable.Ofday.V1.t * Timezone.Stable.V1.t [@@deriving sexp]

        let sexp_of_t t = [%sexp_of: sexp_repr] (ofday t, zone t)

        let t_of_sexp sexp =
          let ofday, zone = [%of_sexp: sexp_repr] sexp in
          create ofday zone
        ;;
      end
    end
  end

  module Zone = Timezone.Stable
end

include (
  T :
    module type of struct
      include T
    end
    with module Table := T.Table
    with module Hash_set := T.Hash_set
    with module Hash_queue := T.Hash_queue
    with module Span := T.Span
    with module Ofday := T.Ofday
    with module Replace_polymorphic_compare := T.Replace_polymorphic_compare
    with module Date_and_ofday := T.Date_and_ofday
    with module Zone := T.Zone
    with type underlying := T.underlying
    with type t := T.t
    with type comparator_witness := T.comparator_witness)

let to_string = T.to_string
let of_string = T.of_string
let of_string_gen = T.of_string_gen
