Source file `weekday.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
(* Copyright (c) 2026, Cargocut and the Lunar developers.
   All rights reserved.

   SPDX-License-Identifier: BSD-3-Clause *)

type t =
  | Mon
  | Tue
  | Wed
  | Thu
  | Fri
  | Sat
  | Sun

type error =
  | Invalid_weekday_number of int
  | Invalid_weekday_string of string

let all = [ Mon; Tue; Wed; Thu; Fri; Sat; Sun ]

let to_int = function
  | Mon -> 0
  | Tue -> 1
  | Wed -> 2
  | Thu -> 3
  | Fri -> 4
  | Sat -> 5
  | Sun -> 6
;;

let from_int = function
  | 0 -> Ok Mon
  | 1 -> Ok Tue
  | 2 -> Ok Wed
  | 3 -> Ok Thu
  | 4 -> Ok Fri
  | 5 -> Ok Sat
  | 6 -> Ok Sun
  | n -> Error (Invalid_weekday_number n)
;;

let to_string = function
  | Mon -> "monday"
  | Tue -> "tuesday"
  | Wed -> "wednesday"
  | Thu -> "thursday"
  | Fri -> "friday"
  | Sat -> "saturday"
  | Sun -> "sunday"
;;

let to_short_string = function
  | Mon -> "mon"
  | Tue -> "tue"
  | Wed -> "wed"
  | Thu -> "thu"
  | Fri -> "fri"
  | Sat -> "sat"
  | Sun -> "sun"
;;

let from_string str =
  match String.(trim @@ lowercase_ascii str) with
  | "mon" | "monday" -> Ok Mon
  | "tue" | "tuesday" -> Ok Tue
  | "wed" | "wednesday" -> Ok Wed
  | "thu" | "thursday" -> Ok Thu
  | "fri" | "friday" -> Ok Fri
  | "sat" | "saturday" -> Ok Sat
  | "sun" | "sunday" -> Ok Sun
  | s -> Error (Invalid_weekday_string s)
;;

let succ = function
  | Sun -> Mon
  | wd ->
    from_int (succ @@ to_int wd)
    |>
    (* NOTE: [Sun] case is guarded so [get_ok] is safe. *)
    Result.get_ok
;;

let pred = function
  | Mon -> Sun
  | wd ->
    from_int (pred @@ to_int wd)
    |>
    (* NOTE: [Mon] case is guarded so [get_ok] is safe. *)
    Result.get_ok
;;

let equal a b =
  let a = to_int a
  and b = to_int b in
  Int.equal a b
;;

let compare a b =
  let a = to_int a
  and b = to_int b in
  Int.compare a b
;;

module CE = struct
  type nonrec t = t

  let equal = equal
  let compare = compare
end

include Util.Make_compare_helpers (CE)

module Infix = struct
  include Util.Make_equal_infix (CE)
  include Util.Make_compare_infix (CE)
end

module Map = Stdlib.Map.Make (CE)
module Set = Stdlib.Set.Make (CE)
include Infix