package sihl-core

  1. Overview
  2. Docs

Source file time.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
type duration =
  | OneSecond
  | OneMinute
  | TenMinutes
  | OneHour
  | OneDay
  | OneWeek
  | OneMonth
  | OneYear
[@@deriving yojson, show, eq]

let duration_to_span duration =
  let duration_s =
    match duration with
    | OneSecond -> 1.
    | OneMinute -> 60.
    | TenMinutes -> 60. *. 10.
    | OneHour -> 60. *. 60.
    | OneDay -> 60. *. 60. *. 24.
    | OneWeek -> 60. *. 60. *. 24. *. 7.
    | OneMonth -> 60. *. 60. *. 24. *. 30.
    | OneYear -> 60. *. 60. *. 24. *. 365.
  in
  Option.get (Ptime.of_float_s duration_s) |> Ptime.to_span
;;

let date_from_now now duration =
  match duration |> duration_to_span |> Ptime.add_span now with
  | Some expiration_date -> expiration_date
  | None -> failwith "Could not determine date in the future"
;;

let ptime_to_yojson ptime = `String (Ptime.to_rfc3339 ptime)

let ptime_of_yojson yojson =
  match
    yojson |> Yojson.Safe.to_string |> Ptime.of_rfc3339 |> Ptime.rfc3339_error_to_msg
  with
  | Ok (ptime, _, _) -> Ok ptime
  | Error (`Msg msg) -> Error msg
;;

let ptime_of_date_string date =
  let date =
    date
    |> String.split_on_char '-'
    |> List.map int_of_string_opt
    |> List.map
         (Option.to_result
            ~none:
              "Invalid date string provided, make sure that year, month and date are ints")
    |> List.fold_left
         (fun result item ->
           match item with
           | Ok item -> Result.map (List.cons item) result
           | Error msg -> Error msg)
         (Ok [])
    |> Result.map List.rev
  in
  match date with
  | Ok [ year; month; day ] ->
    Ptime.of_date (year, month, day)
    |> Option.to_result ~none:"Invalid date provided, only format 1990-12-01 is accepted"
  | Ok _ -> Error "Invalid date provided, only format 1990-12-01 is accepted"
  | Error msg -> Error msg
;;

let ptime_to_date_string ptime =
  let year, month, day = Ptime.to_date ptime in
  let month =
    if month < 10 then Printf.sprintf "0%d" month else Printf.sprintf "%d" month
  in
  let day = if day < 10 then Printf.sprintf "0%d" day else Printf.sprintf "%d" day in
  Printf.sprintf "%d-%s-%s" year month day
;;
OCaml

Innovation. Community. Security.