From 805699fae4366e67a331405aff5cb9de645d4c64 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Sat, 22 Jul 2023 13:05:15 +0200 Subject: New upstream version 1.1.0 --- B0.ml | 1 - CHANGES.md | 19 ++++++++++++++ README.md | 19 +++++++++----- doc/index.mld | 2 +- opam | 4 +-- pkg/META | 10 ++++---- pkg/pkg.ml | 1 - src/ptime.ml | 70 ++++++++++++++++++++++++++++++++++++-------------- src/ptime.mli | 49 ++++++++++++++++++++++++++--------- test/min_clock.ml | 2 +- test/test_date.ml | 8 +++--- test/test_date_time.ml | 9 +++++-- test/test_rfc3339.ml | 12 ++++++--- 13 files changed, 148 insertions(+), 58 deletions(-) diff --git a/B0.ml b/B0.ml index 11fe4fc..3b1b81c 100644 --- a/B0.ml +++ b/B0.ml @@ -1,5 +1,4 @@ open B0_kit.V000 -open B00_std open Result.Syntax (* OCaml library names *) diff --git a/CHANGES.md b/CHANGES.md index 28d4b91..f54a456 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,22 @@ +v1.1.0 2022-12-02 Zagreb +------------------------ + +- `Ptime.of_rfc3339` timezone offset parsing. Be even more lenient + in non-strict parsing mode: allow `hhmm` and `hh` timezone offsets. + (strict is `hh:mm`). Allows to parse an even larger subset of + ISO 8601 than RFC 3339 (#31). +- Add `Ptime.{to,of}_year`. Less costly than extracting the first + component of `Ptime.to_date_time`. Useful for example to find + out which DST rules a timestamp is subjected to for rendering. +- Add `?tz_offset_s` optional argument to `Ptime.{of,to}_date` (#32). +- Add `Ptime.weekday_num`. An integer is often more convenient + than the enum value of `Ptime.weekday` (#30). +- Add `Ptime.rfc3339_string_error` convenience function. +- Use the new `js_of_ocaml` META `ocamlfind` standard to link + JavaScript stubs (#28). +- No longer install interfaces in the `ptime.clock` package, + this package is now empty. + v1.0.0 2022-02-16 La Forclaz ---------------------------- diff --git a/README.md b/README.md index dae89ea..162447e 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ Ptime — POSIX time for OCaml ============================ -v1.0.0 +v1.1.0 Ptime has platform independent POSIX time support in pure OCaml. It provides a type to represent a well-defined range of POSIX timestamps @@ -19,7 +19,7 @@ under the ISC license. [rfc3339]: http://tools.ietf.org/html/rfc3339 -Home page: http://erratique.ch/software/ptime +Home page: # Installation @@ -32,12 +32,17 @@ instructions. # Documentation -The documentation and API reference is generated from the source -interfaces. It can be consulted [online][doc] or via `odig doc ptime`. +The documentation can be consulted [online] or via `odig doc mtime`. -[doc]: http://erratique.ch/software/ptime/doc/ +Questions are welcome but better asked on the [OCaml forum] than on +the issue tracker. + +[online]: http://erratique.ch/software/ptime/doc/ +[OCaml forum]: https://discuss.ocaml.org/ # Sample programs -If you installed Ptime with `opam` sample programs are located in -the directory `opam config var ptime:doc`. +See [test/min_clock.ml](test/min_clock.ml). + +If you installed ptime with `opam` sample programs are located in +the directory `opam var ptime:doc`. diff --git a/doc/index.mld b/doc/index.mld index d6696c1..d29fd8b 100644 --- a/doc/index.mld +++ b/doc/index.mld @@ -1,4 +1,4 @@ -{0 Ptime {%html: v1.0.0%}} +{0 Ptime {%html: v1.1.0%}} {!Ptime} has platform independent support for POSIX time. It provides a {{!Ptime.t}type} to represent a well-defined range of POSIX diff --git a/opam b/opam index a462066..7bb588f 100644 --- a/opam +++ b/opam @@ -1,4 +1,4 @@ -version: "1.0.0" +version: "1.1.0" opam-version: "2.0" name: "ptime" synopsis: "POSIX time for OCaml" @@ -20,7 +20,7 @@ under the ISC license. [rfc3339]: http://tools.ietf.org/html/rfc3339 -Home page: http://erratique.ch/software/ptime""" +Home page: """ maintainer: "Daniel Bünzli " authors: "The ptime programmers" license: "ISC" diff --git a/pkg/META b/pkg/META index 7fd3d60..458d036 100644 --- a/pkg/META +++ b/pkg/META @@ -1,5 +1,5 @@ description = "POSIX time for OCaml" -version = "1.0.0" +version = "1.1.0" requires = "" archive(byte) = "ptime.cma" archive(native) = "ptime.cmxa" @@ -8,7 +8,7 @@ plugin(native) = "ptime.cmxs" package "top" ( description = "Ptime toplevel support" - version = "1.0.0" + version = "1.1.0" requires = "ptime" directory = "top" archive(byte) = "ptime_top.cma" @@ -19,19 +19,19 @@ package "top" ( package "clock" ( description = "POSIX time clock interface" - version = "1.0.0" + version = "1.1.0" requires = "" directory = "clock" package "os" ( description = "Ptime_clock for your platform (including JavaScript)" - version = "1.0.0" + version = "1.1.0" requires = "ptime" directory = "os" archive(byte) = "ptime_clock.cma" archive(native) = "ptime_clock.cmxa" plugin(byte) = "ptime_clock.cma" plugin(native) = "ptime_clock.cmxs" - linkopts(javascript) = "+ptime.clock.os/runtime.js" + jsoo_runtime = "runtime.js" exists_if = "ptime_clock.cma") ) \ No newline at end of file diff --git a/pkg/pkg.ml b/pkg/pkg.ml index 4eb1a42..22a1267 100755 --- a/pkg/pkg.ml +++ b/pkg/pkg.ml @@ -8,7 +8,6 @@ let () = Ok [ Pkg.mllib "src/ptime.mllib"; Pkg.mllib ~api:[] "src/ptime_top.mllib" ~dst_dir:"top/"; Pkg.lib "src/ptime_top_init.ml"; - Pkg.lib ~exts:Exts.interface "src/ptime_clock" ~dst:"clock/"; Pkg.mllib "src-clock/ptime_clock.mllib" ~dst_dir:"clock/os/"; Pkg.clib "src-clock/libptime_clock_stubs.clib" ~lib_dst_dir:"clock/os/"; Pkg.lib "src-clock/runtime.js" ~dst:"clock/os/"; diff --git a/src/ptime.ml b/src/ptime.ml index e3ef8f2..00ff119 100644 --- a/src/ptime.ml +++ b/src/ptime.ml @@ -28,6 +28,15 @@ let jd_to_date jd = let year = 100 * b + d - 4800 + (m / 10) in (year, month, day) +let jd_to_year jd = (* Same as above but only for the year *) + let a = jd + 32044 in + let b = (4 * a + 3) / 146097 in + let c = a - ((146097 * b) / 4) in + let d = (4 * c + 3) / 1461 in + let e = c - ((1461 * d) / 4) in + let m = (5 * e + 2) / 153 in + 100 * b + d - 4800 + (m / 10) + let jd_of_date (year, month, day) = let a = (14 - month) / 12 in let y = year + 4800 - a in @@ -441,21 +450,26 @@ let to_date_time ?(tz_offset_s = 0) t = let ss = Int64.(to_int (div mm_rem ps_count_in_s)) in date, ((hh, mm, ss), tz_offset_s) -let of_date date = of_date_time (date, ((00, 00, 00), 0)) -let to_date t = fst (to_date_time ~tz_offset_s:0 t) +let of_date ?tz_offset_s:(tz = 0) date = of_date_time (date, ((00, 00, 00), tz)) +let to_date ?tz_offset_s t = fst (to_date_time ?tz_offset_s t) +let of_year ?tz_offset_s y = of_date ?tz_offset_s (y, 01, 01) +let to_year ?(tz_offset_s = 0) t = + let d = match add_span t (Span.of_int_s tz_offset_s) with + | None -> fst t (* fallback to UTC *) | Some (local_d, _) -> local_d + in + jd_to_year (d + jd_posix_epoch) + +let weekday_num ?(tz_offset_s = 0) t = + let (d, _) = Span.add t (Span.of_int_s tz_offset_s) in + (* N.B. in contrast to [to_date_time] we don't care if we fall outside + [min;max]. Even if it happens the result of the computation is still + correct *) + let i = (d + 4 (* Epoch, d = 0, was a thu, we want 4 for that day *)) mod 7 in + if i < 0 then 7 + i else i let weekday = - let wday = - (* Epoch was a thursday *) - [| `Thu; `Fri; `Sat; `Sun; `Mon; `Tue; `Wed |] - in - fun ?(tz_offset_s = 0) t -> - let (d, _) = Span.add t (Span.of_int_s tz_offset_s) in - (* N.B. in contrast to [to_date_time] we don't care if we fall outside - [min;max]. Even if it happens the result of the computation is still - correct *) - let i = d mod 7 in - wday.(if i < 0 then 7 + i else i) + let wday = [| `Sun; `Mon; `Tue; `Wed; `Thu; `Fri; `Sat; |] in + fun ?tz_offset_s t -> wday.(weekday_num ?tz_offset_s t) (* RFC 3339 timestamp conversions *) @@ -476,10 +490,18 @@ let pp_rfc3339_error ppf = function in Format.fprintf ppf "@[expected@ a@ character@ in:%a@]" pp_chars cs +let pp_range ppf (s, e) = + if s = e then Format.pp_print_int ppf s else Format.fprintf ppf "%d-%d" s e + +let _rfc3339_error_to_string (r, err) = + Format.asprintf "@[%a: %a@]" pp_range r pp_rfc3339_error err + +let rfc3339_string_error = function +| Ok _ as v -> v | Error (`RFC3339 e) -> Error (_rfc3339_error_to_string e) + let rfc3339_error_to_msg = function -| Ok _ as v -> v -| Error (`RFC3339 ((s, e), err)) -> - Error (`Msg (Format.asprintf "%d-%d: %a" s e pp_rfc3339_error err)) +| Ok _ as v -> v | Error (`RFC3339 e) -> + Error (`Msg (_rfc3339_error_to_string e)) exception RFC3339 of (int * int) * rfc3339_error (* Internal *) @@ -541,10 +563,20 @@ let parse_frac_ps pos max s = let parse_tz_s ~strict pos max s = let parse_tz_mag sign pos = let hh_pos = pos in - let mm_pos = hh_pos + 3 in let hh = parse_digits ~count:2 hh_pos max s in - parse_char ':' (mm_pos - 1) max s; - let mm = parse_digits ~count:2 mm_pos max s in + let mm, mm_pos = match strict with + | true -> + let mm_pos = hh_pos + 3 in + parse_char ':' (mm_pos - 1) max s; + parse_digits ~count:2 mm_pos max s, mm_pos + | false -> + let next = hh_pos + 2 in + if next > max || not (s.[next] = ':' || is_digit s.[next]) + then (0, hh_pos (* end pos of parse - 1, one is added at the end *)) + else + let mm_pos = if s.[next] = ':' then hh_pos + 3 else hh_pos + 2 in + parse_digits ~count:2 mm_pos max s, mm_pos + in if hh > 23 then error (hh_pos, hh_pos + 1) `Invalid_stamp else if mm > 59 then error (mm_pos, mm_pos + 1) `Invalid_stamp else let secs = hh * 3600 + mm * 60 in diff --git a/src/ptime.mli b/src/ptime.mli index ce84a16..7ac1544 100644 --- a/src/ptime.mli +++ b/src/ptime.mli @@ -308,6 +308,8 @@ type time = (int * int * int) * tz_offset_s A [time] value is said to be {e valid} iff the values [(hh, mm, ss)] are in the ranges mentioned above. *) +(** {2:datetimes Date and time} *) + val of_date_time : date * time -> t option (** [of_date_time dt] is the POSIX timestamp corresponding to date-time [dt] or [None] if [dt] has an {{!date}invalid date}, @@ -348,20 +350,36 @@ val to_date_time : ?tz_offset_s:tz_offset_s -> t -> date * time are floored, i.e. the date-time always has the second mentioned in the timestamp. *) -val of_date : date -> t option -(** [of_date d] is [of_date_time (d, ((00, 00, 00), 0 (* UTC *)))]. *) +(** {2:dates Date} *) + +val of_date : ?tz_offset_s:tz_offset_s -> date -> t option +(** [of_date d] is + [of_date_time (d, ((00, 00, 00), tz_offset_s))]. [tz_offset_s] + defaults to 0, i.e. UTC. *) + +val to_date : ?tz_offset_s:tz_offset_s -> t -> date +(** [to_date t] is [fst (to_date_time ?tz_offset_s t)]. *) + +(** {2:years Year} *) -val to_date : t -> date -(** [to_date t] is [fst (to_date_time t)]. *) +val of_year : ?tz_offset_s:tz_offset_s -> int -> t option +(** [of_year y] is [of_date ?tz_offset_s (y, 01, 01)]. *) + +val to_year : ?tz_offset_s:tz_offset_s -> t -> int +(** [to_year t] is the first component of [(to_date ?tz_offset_s t))] but + more efficient. *) + +(** {2:weekdays Week days} *) val weekday : ?tz_offset_s:tz_offset_s -> t -> - [ `Mon | `Tue | `Wed | `Thu | `Fri | `Sat | `Sun ] + [ `Sun | `Mon | `Tue | `Wed | `Thu | `Fri | `Sat ] (** [weekday ~tz_offset_s t] is the day in the 7-day week of timestamp [t] - expressed in the time zone offset [ts_offset_s] (defaults to [0]). + expressed in the time zone offset [ts_offset_s] (defaults to [0]). *) - This can be used with the time zone offset result of {!to_date_time} - to convert timestamps to denormalized timestamp formats. *) +val weekday_num : ?tz_offset_s:tz_offset_s -> t -> int +(** [weekday_num] is like {!weekday} but returns a weekday number, 0 + is sunday, 1 is monday, …, 6 is saturday etc. *) (** {1:rfc3339 RFC 3339 timestamp conversions} *) @@ -387,6 +405,11 @@ val rfc3339_error_to_msg : ('a, [`RFC3339 of error_range * rfc3339_error]) (** [rfc3339_error_to_msg r] converts RFC 3339 parse errors to error messages. *) +val rfc3339_string_error : + ('a, [`RFC3339 of error_range * rfc3339_error]) result -> ('a, string) result +(** [rfc3339_string_error r] converts RFC 3339 parse errors errors to + string errors. *) + val of_rfc3339 : ?strict:bool -> ?sub:bool -> ?start:int -> string -> ((t * tz_offset_s option * int), [> `RFC3339 of error_range * rfc3339_error]) result @@ -404,10 +427,12 @@ val of_rfc3339 : ?strict:bool -> ?sub:bool -> ?start:int -> string -> timestamp. If [sub] is [false] (default) this is always [String.length s - start] and [Error `Trailing_input] is returned if there are still bytes in [s] after the date-time was parsed. Use - [~sub:true] for allowing trailing input to exist.}} - If [strict] is [true] (defaults to [false]) the parsing function - errors on timestamps with lowercase ['T'] or ['Z'] characters or - space separated date and times. + [~sub:true] for allowing trailing input to exist.} + {- [strict] if [false] (default) the pasring function does + not error on timestamp with lowercase ['T'] or ['Z'] characters, or + space separated date and times, and `hhmm` and `hh` timezone + offsets (strict mandates [hh:mm]). This allows to parse a slightly + larger subset of ISO 8601 than what RFC 3339 allows}} {b Notes and limitations.} {ul diff --git a/test/min_clock.ml b/test/min_clock.ml index f125a3e..b695d3e 100644 --- a/test/min_clock.ml +++ b/test/min_clock.ml @@ -8,7 +8,7 @@ -package ptime.clock.os -linkpkg -o min_clock.byte min_clock.ml js_of_ocaml \ - $(ocamlfind query ptime.clock.os -predicates javascript -o-format -r) \ + $(ocamlfind query -format "%+(jsoo_runtime)" -r ptime.clock.os) \ min_clock.byte *) diff --git a/test/test_date.ml b/test/test_date.ml index 5c3dc08..8cee25c 100644 --- a/test/test_date.ml +++ b/test/test_date.ml @@ -10,10 +10,10 @@ let stamp_of_date_time d = (Ptime.of_date_time $ raw_date_time @-> ret_get_option stamp) d let valid_date d = - ignore ((Ptime.of_date $ raw_date @-> ret_some stamp) d) + ignore ((Ptime.of_date ?tz_offset_s:None $ raw_date @-> ret_some stamp) d) let wrong_date d = - ignore ((Ptime.of_date $ raw_date @-> ret_none stamp) d) + ignore ((Ptime.of_date ?tz_offset_s:None $ raw_date @-> ret_none stamp) d) let bounds = test "Testing calendar date field bounds" @@ fun () -> (* Check year bounds *) @@ -118,7 +118,9 @@ let bounds = test "Testing calendar date field bounds" @@ fun () -> () let stamp_trips = test "Random valid dates to stamps round trips" @@ fun () -> - let of_date = Ptime.of_date $ raw_date @-> ret_get_option stamp in + let of_date = + Ptime.of_date ?tz_offset_s:None $ raw_date @-> ret_get_option stamp + in for i = 1 to Test_rand.loop_len () do let date = Test_rand.date () in let trip = Ptime.to_date (of_date date) in diff --git a/test/test_date_time.ml b/test/test_date_time.ml index 6f58b1e..89286b8 100644 --- a/test/test_date_time.ml +++ b/test/test_date_time.ml @@ -151,7 +151,11 @@ let round_trips = let (_, (_, tz_offset_s) as dt) = rand_date_time_stamp () in let stamp = stamp_of_date_time dt in if not (is_leap_sec dt) - then eq_date_time dt (Ptime.to_date_time ~tz_offset_s stamp) + then begin + let ((y, _, _), _ as dt') = Ptime.to_date_time ~tz_offset_s stamp in + assert (Ptime.to_year ~tz_offset_s stamp = y); + eq_date_time dt dt' + end else begin (* Verify we map the leap sec on the the second after. *) let before_leap_dt = match dt with @@ -165,7 +169,8 @@ let round_trips = () let weekday = - test "Ptime.weekday" @@ fun () -> + test "Ptime.{weekday_num,weekday}" @@ fun () -> + (* weekday tests weekday_num *) let pp_weekday ppf v = Format.pp_print_string ppf begin match v with | `Mon -> "`Mon" | `Tue -> "`Tue" | `Wed -> "`Wed" | `Thu -> "`Thu" | `Fri -> "`Fri" | `Sat -> "`Sat" | `Sun -> "`Sun" diff --git a/test/test_rfc3339.ml b/test/test_rfc3339.ml index a80d2f5..f1e4a04 100644 --- a/test/test_rfc3339.ml +++ b/test/test_rfc3339.ml @@ -100,9 +100,7 @@ let parse = test "RFC 3339 to stamp conversions" @@ fun () -> let etz_strict = `Exp_chars ['+'; '-'; 'Z'] in let edtsep = `Exp_chars ['T';'t';' '] in let edtsep_strict = `Exp_chars ['T'] in - let p ?strict ?sub ?start ?len s = - Ptime.of_rfc3339 ?strict ?sub ?start s - in + let p ?strict ?sub ?start ?len s = Ptime.of_rfc3339 ?strict ?sub ?start s in let err (s,e) err = Error (`RFC3339 ((s, e), err)) in let err_pos pos e = err (pos, pos) e in let ok s ~tz ~count = Ok (stamp_of_s s, tz, count) in @@ -161,7 +159,9 @@ let parse = test "RFC 3339 to stamp conversions" @@ fun () -> eq_result (p "1969-12X31T23:59:58Z") (err_pos 7 (`Exp_chars ['-'])); eq_result (p "1969-12-31T23X59:58Z") (err_pos 13 (`Exp_chars [':'])); eq_result (p "1969-12-31T23:59X58Z") (err_pos 16 (`Exp_chars [':'])); - eq_result (p "1969-12-31T23:59:58+00X00") (err_pos 22 (`Exp_chars [':'])); + eq_result (p ~strict:true "1969-12-31T23:59:58+00X00") + (err_pos 22 (`Exp_chars [':'])); + eq_result (p "1969-12-31T23:59:58+00X00") (err_pos 22 `Trailing_input); eq_result (p ~start:(-1) "1970-01-01") (err_pos (-1) `Eoi); eq_result (p ~start:11 "1970-01-01") (err_pos 11 `Eoi); eq_result (p "") (err_pos 0 `Eoi); @@ -169,6 +169,10 @@ let parse = test "RFC 3339 to stamp conversions" @@ fun () -> eq_result (p "9999-12-31T23:59:59-00:01") (err (0, 24) `Invalid_stamp); eq_result (p "1900-02-29T01:02:03Z") (err (0, 19) `Invalid_stamp); eq_result (p "01-02-29T01:02:03Z") (err_pos 2 edigit); + eq_result (p "1970-01-01T00:00:00.00+0101") + (ok (-3660.00) ~tz:(Some 3660) ~count:27); + eq_result (p "1970-01-01T00:00:00.00+01") + (ok (-3600.00) ~tz:(Some 3600) ~count:25); () let stamp_trips = test "Random stamps to RFC 3339 round trips" @@ fun () -> -- cgit v1.2.3