package core_unix

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file time_float_unix.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
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