forked from
jonmsterling.com/ocaml-forester
ocaml
swapping out date handling
+47
-87
+4
-4
lib/forest/Legacy_xml_client.ml
+4
-4
lib/forest/Legacy_xml_client.ml
···
376
376
377
377
and render_date (date : Date.t) =
378
378
let href_attr =
379
-
let str = Format.asprintf "%a" Date.pp date in
379
+
let str = Format.asprintf "%a" Date.pp (Date.drop_time date) in
380
380
let base = Iri_scheme.base_iri ~host: Params.host in
381
381
let iri = Iri.resolve ~base (Iri.of_string str) in
382
382
match F.get_article iri with
···
386
386
X.date
387
387
[href_attr]
388
388
[
389
-
X.year [] "%i" date.yyyy;
390
-
date.mm |> X.optional @@ X.month [] "%i";
391
-
date.dd |> X.optional @@ X.day [] "%i"
389
+
X.year [] "%i" (Date.year date);
390
+
Date.month date |> X.optional @@ X.month [] "%i";
391
+
Date.day date |> X.optional @@ X.day [] "%i"
392
392
]
393
393
394
394
let render_article (article : T.content T.article) : P.node =
+5
lib/human_datetime/Forester_human_datetime.ml
+5
lib/human_datetime/Forester_human_datetime.ml
+7
-1
lib/human_datetime/Types.ml
+7
-1
lib/human_datetime/Types.ml
···
149
149
state.date.year <- y;
150
150
Option.iter (go_month state) month_opt
151
151
in
152
-
153
152
let state = init_ptime_date_time_state () in
154
153
go_year state datetime;
155
154
let date = state.date.year, state.date.month, state.date.day in
156
155
let time = ((state.time.hour, state.time.minute, state.time.second), state.tz_offset_s) in
157
156
Ptime.of_date_time (date, time)
157
+
158
+
let compare_datetime dt0 dt1 =
159
+
match to_ptime dt0, to_ptime dt1 with
160
+
| Some x0, Some x1 -> Ptime.compare x0 x1
161
+
| None, None -> 0
162
+
| None, Some _ -> -1
163
+
| Some _, None -> 1
+27
-80
lib/prelude/Date.ml
+27
-80
lib/prelude/Date.ml
···
1
-
open Fun_util
2
1
module HDT = Forester_human_datetime
3
2
4
-
type t = { yyyy: int; mm: int option; dd: int option }
5
-
[@@deriving repr]
3
+
type t = HDT.datetime
6
4
7
-
let year d = d.yyyy
8
-
let month d = d.mm
9
-
let day d = d.dd
5
+
let drop_time = function
6
+
| HDT.Year (y, Some (HDT.Month (m, Some (HDT.Day (d, _))))) ->
7
+
HDT.Year (y, Some (HDT.Month (m, Some (HDT.Day (d, None)))))
8
+
| dt -> dt
10
9
11
-
let now () =
12
-
let t = Unix.localtime (Unix.time ()) in
13
-
{ yyyy = 1900 + t.tm_year; mm = Some (1 + t.tm_mon); dd = Some t.tm_mday }
10
+
let t =
11
+
let of_string str = HDT.parse_string_exn str in
12
+
let to_string dt = Format.asprintf "%a" HDT.pp_datetime dt in
13
+
Repr.map Repr.string of_string to_string
14
14
15
-
(* approximate, only for sorting *)
16
-
let to_ptime (date : t) : Ptime.t =
17
-
let dd = Option.value ~default: 1 date.dd in
18
-
let mm = Option.value ~default: 1 date.mm in
19
-
match Ptime.of_date (date.yyyy, mm, dd) with
20
-
| None -> failwith "to_ptime"
21
-
| Some t -> t
15
+
let pp = HDT.pp_datetime
16
+
let parse = HDT.parse_string
17
+
let compare = HDT.compare_datetime
22
18
23
-
let compare (d0 : t) (d1 : t) =
24
-
Ptime.compare (to_ptime d0) (to_ptime d1)
19
+
let year = function HDT.Year (y, _) -> y
25
20
26
-
let parse_date str =
27
-
match String.split_on_char '-' str with
28
-
| yyyy :: rest ->
29
-
let yyyy = int_of_string yyyy in
30
-
begin
31
-
match rest with
32
-
| mm :: rest ->
33
-
let mm = Some (int_of_string mm) in
34
-
begin
35
-
match rest with
36
-
| [dd] ->
37
-
let dd = Some (int_of_string dd) in
38
-
Some { yyyy; mm; dd }
39
-
| _ ->
40
-
Some { yyyy; mm; dd = None }
41
-
end
42
-
| _ ->
43
-
Some { yyyy; mm = None; dd = None }
44
-
end
45
-
| _ ->
46
-
None
21
+
let month = function
22
+
| HDT.Year (_, Some (HDT.Month (m, _))) -> Some m
23
+
| _ -> None
47
24
48
-
let parse str =
49
-
match String.split_on_char 'T' str with
50
-
| [date] -> parse_date date
51
-
| date :: _ -> parse_date date
52
-
| _ ->
53
-
None
25
+
let day = function
26
+
| HDT.Year (_, Some (HDT.Month (_, Some (HDT.Day (d, _))))) -> Some d
27
+
| _ -> None
54
28
55
-
let pp fmt date =
56
-
Format.fprintf fmt "%04d" date.yyyy;
57
-
let@ mm = Option.iter @~ date.mm in
58
-
Format.fprintf fmt "-%02d" mm;
59
-
let@ dd = Option.iter @~ date.dd in
60
-
Format.fprintf fmt "-%02d" dd
61
-
62
-
let pp_month fmt i =
63
-
Format.fprintf fmt "%s" @@
64
-
match i with
65
-
| 1 -> "January"
66
-
| 2 -> "February"
67
-
| 3 -> "March"
68
-
| 4 -> "April"
69
-
| 5 -> "May"
70
-
| 6 -> "June"
71
-
| 7 -> "July"
72
-
| 8 -> "August"
73
-
| 9 -> "September"
74
-
| 10 -> "October"
75
-
| 11 -> "November"
76
-
| 12 -> "December"
77
-
| _ ->
78
-
failwith @@ Format.sprintf "Invalid date: %i" i
79
-
80
-
let pp_human fmt date =
81
-
match date.mm with
82
-
| None ->
83
-
Format.fprintf fmt "%04d" date.yyyy
84
-
| Some mm ->
85
-
match date.dd with
86
-
| None ->
87
-
Format.fprintf fmt "%a %04d" pp_month mm date.yyyy
88
-
| Some dd ->
89
-
Format.fprintf fmt "%a %i, %04d" pp_month mm dd date.yyyy
29
+
let now () =
30
+
let t = Unix.gmtime (Unix.time ()) in
31
+
let second = HDT.Second t.tm_sec in
32
+
let minute = HDT.Minute (t.tm_min, Some second) in
33
+
let hour = HDT.Hour (t.tm_hour, Some minute) in
34
+
let day = HDT.Day (t.tm_mday, Some (hour, HDT.Z)) in
35
+
let month = HDT.Month (1 + t.tm_mon, Some day) in
36
+
HDT.Year (1900 + t.tm_year, Some month)
+4
-2
lib/prelude/Date.mli
+4
-2
lib/prelude/Date.mli