Source file `month.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
open! Import

module Stable = struct
  module V1 = struct
    type t =
      | Jan
      | Feb
      | Mar
      | Apr
      | May
      | Jun
      | Jul
      | Aug
      | Sep
      | Oct
      | Nov
      | Dec
    [@@deriving sexp, compare, hash, variants, equal]

    let failwithf = Printf.failwithf

    let of_int_exn i : t =
      match i with
      | 1 -> Jan
      | 2 -> Feb
      | 3 -> Mar
      | 4 -> Apr
      | 5 -> May
      | 6 -> Jun
      | 7 -> Jul
      | 8 -> Aug
      | 9 -> Sep
      | 10 -> Oct
      | 11 -> Nov
      | 12 -> Dec
      | _ -> failwithf "Month.of_int_exn %d" i ()
    ;;

    let of_int i =
      try Some (of_int_exn i) with
      | _ -> None
    ;;

    let to_int (t : t) =
      match t with
      | Jan -> 1
      | Feb -> 2
      | Mar -> 3
      | Apr -> 4
      | May -> 5
      | Jun -> 6
      | Jul -> 7
      | Aug -> 8
      | Sep -> 9
      | Oct -> 10
      | Nov -> 11
      | Dec -> 12
    ;;

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

          let to_binable t = to_int t - 1
          let of_binable i = of_int_exn (i + 1)
        end)
  end
end

let num_months = 12

module T = struct
  include Stable.V1

  let all = [ Jan; Feb; Mar; Apr; May; Jun; Jul; Aug; Sep; Oct; Nov; Dec ]
  let hash = to_int
end

include T

include (
  Hashable.Make_binable (struct
    include T
  end) :
    Hashable.S_binable with type t := t)

include Comparable.Make_binable (struct
    include T

    (* In 108.06a and earlier, months in sexps of Maps and Sets were raw ints.  From 108.07
       through 109.13, the output format remained raw as before, but both the raw and
       pretty format were accepted as input.  From 109.14 on, the output format was
       changed from raw to pretty, while continuing to accept both formats.  Once we believe
       most programs are beyond 109.14, we will switch the input format to no longer accept
       raw. *)
    let t_of_sexp sexp =
      match Option.try_with (fun () -> Int.t_of_sexp sexp) with
      | Some i -> of_int_exn (i + 1)
      | None -> T.t_of_sexp sexp
    ;;
  end)

(* Replace the overriden sexp converters from [Comparable.Make_binable] with the ordinary
   symbolic converters. *)
let sexp_of_t = T.sexp_of_t
let t_of_sexp = T.t_of_sexp
let shift t i = of_int_exn (1 + Int.( % ) (to_int t - 1 + i) num_months)

let all_strings =
  lazy
    (Array.of_list (List.map all ~f:(fun variant -> Sexp.to_string (sexp_of_t variant))))
;;

let to_string (t : t) =
  let all_strings = Lazy.force all_strings in
  all_strings.(to_int t - 1)
;;

let of_string =
  let table =
    lazy
      (let module T = String.Table in
       let table = T.create ~size:num_months () in
       Array.iteri (Lazy.force all_strings) ~f:(fun i s ->
         let t = of_int_exn (i + 1) in
         Hashtbl.set table ~key:s ~data:t;
         Hashtbl.set table ~key:(String.lowercase s) ~data:t;
         Hashtbl.set table ~key:(String.uppercase s) ~data:t);
       table)
  in
  fun str ->
    match Hashtbl.find (Lazy.force table) str with
    | Some x -> x
    | None -> failwithf "Invalid month: %s" str ()
;;

module Export = struct
  type month = t =
    | Jan
    | Feb
    | Mar
    | Apr
    | May
    | Jun
    | Jul
    | Aug
    | Sep
    | Oct
    | Nov
    | Dec
end