Source file `timedesc_sexp.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
let wrap_to_sexp_into_pp_sexp (f : 'a -> Sexplib.Sexp.t) :
  Format.formatter -> 'a -> unit =
  fun formatter x -> Sexplib.Sexp.pp formatter (f x)

module Date = struct
  let to_sexp = To_sexp.sexp_of_date

  let to_sexp_string x = Sexplib.Sexp.to_string (To_sexp.sexp_of_date x)

  let of_sexp = Of_sexp_utils.wrap_of_sexp Of_sexp.date_of_sexp

  let of_sexp_string =
    Of_sexp_utils.wrap_of_sexp_into_of_sexp_string Of_sexp.date_of_sexp

  let pp_sexp = wrap_to_sexp_into_pp_sexp To_sexp.sexp_of_date
end

module Time = struct
  let to_sexp = To_sexp.sexp_of_time

  let to_sexp_string x = Sexplib.Sexp.to_string (To_sexp.sexp_of_time x)

  let of_sexp = Of_sexp_utils.wrap_of_sexp Of_sexp.time_of_sexp

  let of_sexp_string =
    Of_sexp_utils.wrap_of_sexp_into_of_sexp_string Of_sexp.time_of_sexp

  let pp_sexp = wrap_to_sexp_into_pp_sexp To_sexp.sexp_of_time
end

module Span = struct
  let to_sexp = To_sexp.sexp_of_span

  let to_sexp_string x = Sexplib.Sexp.to_string (To_sexp.sexp_of_span x)

  let of_sexp = Of_sexp_utils.wrap_of_sexp Of_sexp.span_of_sexp

  let of_sexp_string =
    Of_sexp_utils.wrap_of_sexp_into_of_sexp_string Of_sexp.span_of_sexp

  let pp_sexp = wrap_to_sexp_into_pp_sexp To_sexp.sexp_of_span
end

module Timestamp = struct
  let of_sexp = Of_sexp_utils.wrap_of_sexp Of_sexp.span_of_sexp

  let to_sexp = To_sexp.sexp_of_span
end

let to_sexp = To_sexp.sexp_of_date_time

let to_sexp_string x = Sexplib.Sexp.to_string (To_sexp.sexp_of_date_time x)

let of_sexp = Of_sexp_utils.wrap_of_sexp Of_sexp.date_time_of_sexp

let of_sexp_string =
  Of_sexp_utils.wrap_of_sexp_into_of_sexp_string Of_sexp.date_time_of_sexp

let pp_sexp = wrap_to_sexp_into_pp_sexp To_sexp.sexp_of_date_time

module Zoneless = struct
  let to_sexp = To_sexp.sexp_of_zoneless

  let of_sexp = Of_sexp_utils.wrap_of_sexp Of_sexp.zoneless_of_sexp
end

module Time_zone = struct
  open Sexplib

  let of_sexp (x : Sexp.t) : Timedesc.Time_zone.t option =
    let open Of_sexp_utils in
    try
      match x with
      | List l -> (
          match l with
          | Atom "tz" :: Atom name :: transitions ->
            transitions
            |> List.map (fun x ->
                match x with
                | Sexp.List [ start; List [ Atom is_dst; offset ] ] ->
                  let start = int64_of_sexp start in
                  let is_dst =
                    match is_dst with
                    | "t" -> true
                    | "f" -> false
                    | _ -> invalid_data ""
                  in
                  let offset = int_of_sexp offset in
                  let entry = Timedesc.Time_zone.{ is_dst; offset } in
                  (start, entry)
                | _ -> invalid_data "")
            |> Timedesc.Time_zone.Raw.of_transitions ~name
          | _ -> invalid_data "")
      | Atom _ -> invalid_data ""
    with _ -> None

  let to_sexp (t : Timedesc.Time_zone.t) : Sexp.t =
    let open To_sexp_utils in
    Sexp.List
      (Atom "tz"
       :: Atom (Timedesc.Time_zone.name t)
       :: List.map
         (fun ((start, _), entry) ->
            Sexp.List
              [
                sexp_of_int64 start;
                Sexp.List
                  [
                    (if Timedesc.Time_zone.(entry.is_dst) then Atom "t" else Atom "f");
                    sexp_of_int entry.offset;
                  ];
              ])
         (Timedesc.Time_zone.Raw.to_transitions t))

  let of_string s =
    match Sexp.of_string s with
    | exception _ -> None
    | x -> of_sexp x

  module Db = struct
    open Sexplib

    let of_sexp (x : Sexp.t) : Timedesc.Time_zone.Db.db option =
      let open Of_sexp_utils in
      try
        match x with
        | Atom _ -> invalid_data ""
        | List l ->
          Some
            (l
             |> List.to_seq
             |> Seq.map (fun x ->
                 match of_sexp x with
                 | None -> invalid_data ""
                 | Some x -> x)
             |> Timedesc.Time_zone.Db.of_seq)
      with _ -> None

    let to_sexp db =
      Sexp.List
        (Timedesc_tzdb.M.bindings db
         |> List.map (fun (name, table) ->
             Timedesc.Time_zone.Raw.of_table_exn ~name table)
         |> List.map to_sexp
        )

    let of_string s =
      match Sexp.of_string s with
      | exception _ -> None
      | x -> of_sexp x
  end
end

module Time_zone_info = struct
  let of_sexp = Of_sexp_utils.wrap_of_sexp Of_sexp.tz_info_of_sexp

  let to_sexp = To_sexp.sexp_of_tz_info
end