package timedesc-sexp

  1. Overview
  2. Docs

Source file of_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
open Sexplib
open Of_sexp_utils
module T = Timedesc

let int_of_sexp (x : Sexp.t) =
  match x with
  | Atom s -> (
      try int_of_string s
      with Failure _ ->
        invalid_data (Printf.sprintf "Failed to parse int: %s" s))
  | List _ ->
    invalid_data
      (Printf.sprintf "Expected atom for int: %s" (Sexp.to_string x))

let ints_of_sexp_list (x : Sexp.t) =
  match x with
  | Atom _ ->
    invalid_data
      (Printf.sprintf "Expected list for ints: %s" (Sexp.to_string x))
  | List l -> List.map int_of_sexp l

let span_of_sexp (x : Sexp.t) =
  match x with
  | Atom _ ->
    invalid_data
      (Printf.sprintf "Expected list for span: %s" (Sexp.to_string x))
  | List [ s; ns ] ->
    let s = int64_of_sexp s in
    let ns = int_of_sexp ns in
    T.Span.make ~s ~ns ()
  | List _ ->
    invalid_data
      (Printf.sprintf "List too long for span: %s" (Sexp.to_string x))

let tz_make_of_sexp (x : Sexp.t) =
  match x with
  | Atom s -> (
      match T.Time_zone.make s with
      | Some x -> x
      | None -> invalid_data (Printf.sprintf "Unrecognized time zone: %s" s))
  | List _ ->
    invalid_data
      (Printf.sprintf "Expected atom for time zone: %s" (Sexp.to_string x))

let tz_info_of_sexp (x : Sexp.t) : T.Time_zone_info.t =
  match x with
  | Atom _ ->
    invalid_data (Printf.sprintf "Invalid tz_info: %s" (Sexp.to_string x))
  | List l -> (
      match l with
      | [ x ] -> T.Time_zone_info.make_exn ~tz:(tz_make_of_sexp x) ()
      | [ x; offset_from_utc ] ->
        T.Time_zone_info.make_exn 
          ~tz:(tz_make_of_sexp x)
          ~offset_from_utc:
            (T.Span.make
               ~s:(Int64.of_int @@ int_of_sexp offset_from_utc)
               ())
          ()
      | _ ->
        invalid_data
          (Printf.sprintf "Invalid tz_info: %s" (Sexp.to_string x)))

let date_of_sexp (x : Sexp.t) =
  let invalid_data () =
    invalid_data (Printf.sprintf "Invalid date: %s" (Sexp.to_string x))
  in
  match x with
  | List [ year; month; day ] -> (
      let year = int_of_sexp year in
      let month = int_of_sexp month in
      let day = int_of_sexp day in
      match T.Date.Ymd.make ~year ~month ~day with
      | Ok x -> x
      | Error _ -> invalid_data ())
  | _ -> invalid_data ()

let time_of_sexp (x : Sexp.t) =
  let invalid_data () =
    invalid_data (Printf.sprintf "Invalid time: %s" (Sexp.to_string x))
  in
  match x with
  | List [ hour; minute; second; ns ] -> (
      let hour = int_of_sexp hour in
      let minute = int_of_sexp minute in
      let second = int_of_sexp second in
      let ns = int_of_sexp ns in
      match T.Time.make ~hour ~minute ~second ~ns () with
      | Ok x -> x
      | Error _ -> invalid_data ())
  | _ -> invalid_data ()

let zoneless_of_sexp (x : Sexp.t) =
  let invalid_data () =
    invalid_data (Printf.sprintf "Invalid zoneless: %s" (Sexp.to_string x))
  in
  match x with
  | List [ date; time ] ->
    let date = date_of_sexp date in
    let time = time_of_sexp time in
    T.Zoneless.of_date_and_time date time
  | _ -> invalid_data ()

let date_time_of_sexp (x : Sexp.t) =
  let invalid_data () =
    invalid_data (Printf.sprintf "Invalid date time: %s" (Sexp.to_string x))
  in
  match x with
  | List [ date; time; tz; offset_from_utc ] ->
    let date = date_of_sexp date in
    let time = time_of_sexp time in
    let tz = tz_make_of_sexp tz in
    let offset_from_utc =
      match offset_from_utc with
      | List [ Atom "single"; offset ] ->
        `Single (T.Span.make_small ~s:(int_of_sexp offset) ())
      | List [ Atom "ambiguous"; offset1; offset2 ] ->
        let offset1 = T.Span.make_small ~s:(int_of_sexp offset1) () in
        let offset2 = T.Span.make_small ~s:(int_of_sexp offset2) () in
        `Ambiguous (offset1, offset2)
      | _ -> invalid_data ()
    in
    let dt =
      match offset_from_utc with
      | `Single offset_from_utc -> (
          match
            T.of_date_and_time_unambiguous ~tz ~offset_from_utc
              date time
          with
          | Ok x -> x
          | Error _ -> invalid_data ())
      | `Ambiguous _ -> (
          match
            T.of_date_and_time ~tz date time
          with
          | Ok x ->
            if
              T.equal_local_dt_result ~eq:T.Span.equal offset_from_utc
                T.(offset_from_utc x)
            then x
            else invalid_data ()
          | Error _ -> invalid_data ())
    in
    dt
  | _ -> invalid_data ()