Add Pgx_value_ptime with ptime converters (#114)

This change addresses issue #97 by introducing a new package called Pgx_value_ptime. This package is analogous to Pgx_value_core, but uses Ptime for date/date-time processing instead of Core.

The tests for Pgx_value_ptime are pretty much the same as those for Pgx_value_core, although I did add some extra tests for dates.

dune-project

@@ -145,6 +145,22 @@
   (pgx
    (= :version))))
 
+(package
+ (name pgx_value_ptime)
+ (synopsis "Pgx_value converters for Ptime types")
+ (description "Pgx_value converters for Ptime types")
+ (depends
+  (alcotest
+   (and
+    :with-test
+    (>= 1.0.0)))
+  (ptime
+   (>= 0.8.3))
+  (ocaml
+   (>= 4.08))
+  (pgx
+   (= :version))))
+
 (package
  (name pgx_lwt_mirage)
  (synopsis "Pgx using Lwt on Mirage for IO")

pgx_value_ptime.opam

@@ -0,0 +1,32 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Pgx_value converters for Ptime types"
+description: "Pgx_value converters for Ptime types"
+maintainer: ["Arena Developers <silver-snakes@arena.io>"]
+authors: ["Arena Developers <silver-snakes@arena.io>"]
+license: "LGPL-2.0-only with OCaml-LGPL-linking-exception"
+homepage: "https://github.com/arenadotio/pgx"
+doc: "https://arenadotio.github.io/pgx"
+bug-reports: "https://github.com/arenadotio/pgx/issues"
+depends: [
+  "dune" {>= "1.11"}
+  "alcotest" {with-test & >= "1.0.0"}
+  "ptime" {>= "0.8.3"}
+  "ocaml" {>= "4.08"}
+  "pgx" {= version}
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/arenadotio/pgx.git"

pgx_value_ptime/src/dune

@@ -0,0 +1,15 @@
+(* -*- tuareg -*- *)
+
+let preprocess =
+  match Sys.getenv "BISECT_ENABLE" with
+  | "yes" -> "(preprocess (pps bisect_ppx))"
+  | _ -> ""
+  | exception Not_found -> ""
+
+let () = Jbuild_plugin.V1.send @@ {|
+
+(library
+ (public_name pgx_value_ptime)
+ (libraries ptime pgx)
+ |} ^ preprocess ^ {|)
+|}

pgx_value_ptime/src/pgx_value_ptime.ml

@@ -0,0 +1,58 @@
+include Pgx.Value
+
+let of_date (year, month, day) =
+  Printf.sprintf "%04d-%02d-%02d" year month day |> Pgx.Value.of_string
+;;
+
+let to_date' text =
+  match text ^ "T00:00:00Z" |> Ptime.of_rfc3339 with
+  | Result.Ok (t, _, _) -> Ptime.to_date t
+  | _ -> convert_failure "date" text
+;;
+
+let to_date_exn v = Pgx.Value.to_string_exn v |> to_date'
+let to_date v = Pgx.Value.to_string v |> Option.map to_date'
+
+let of_time ?tz_offset_s t =
+  let tz_offset_s = Option.value tz_offset_s ~default:0 in
+  Ptime.to_rfc3339 ~tz_offset_s ~frac_s:12 t |> Pgx.Value.of_string
+;;
+
+let time_of_string text =
+  match Ptime.of_rfc3339 text with
+  | Result.Ok (t, offset, _) -> t, Option.value ~default:0 offset
+  | _ -> convert_failure "time" text
+;;
+
+let to_time' text =
+  (*
+       The time string can come in various forms depending on whether the
+       Postgres timestamp used includes the time zone:
+
+       Without timezone
+       2016-06-07 15:37:46
+       2016-06-07 15:37:46.962425
+
+       With timezone
+       2016-06-07 15:37:46-04
+       2016-06-07 15:37:46.962425-04
+
+       For the first one we need to indicate that it's a UTC time by appending
+       a 'Z'. For the second one we need to append the minutes to the timezone.
+    *)
+  let open Re in
+  let tz = seq [ alt [ char '-'; char '+' ]; digit; digit ] in
+  let utctz = seq [ char 'Z'; eol ] |> compile in
+  let localtz = seq [ tz; char ':'; digit; digit; eol ] |> compile in
+  let localtz_no_min = seq [ tz; eol ] |> compile in
+  time_of_string
+  @@
+  match matches utctz text, matches localtz text, matches localtz_no_min text with
+  | [], [], [] -> text ^ "Z"
+  | _, _, [] -> text
+  | [], [], _ -> text ^ ":00"
+  | _ -> convert_failure "time" text
+;;
+
+let to_time_exn v = Pgx.Value.to_string_exn v |> to_time'
+let to_time v = Pgx.Value.to_string v |> Option.map to_time'

pgx_value_ptime/src/pgx_value_ptime.mli

@@ -0,0 +1,17 @@
+(** Pgx_value types using Ptime's Date and Time modules
+
+To use Ptime in utop, first run: #require "ptime";;
+*)
+
+type v = Pgx.Value.v [@@deriving compare, sexp_of]
+type t = Pgx.Value.t [@@deriving compare, sexp_of]
+
+include module type of Pgx.Value with type v := v and type t := t
+
+val of_date : Ptime.date -> t
+val to_date_exn : t -> Ptime.date
+val to_date : t -> Ptime.date option
+val of_time : ?tz_offset_s:Ptime.tz_offset_s -> Ptime.t -> t
+val to_time_exn : t -> Ptime.t * Ptime.tz_offset_s
+val to_time : t -> (Ptime.t * Ptime.tz_offset_s) option
+val time_of_string : string -> Ptime.t * Ptime.tz_offset_s

pgx_value_ptime/test/dune

@@ -0,0 +1,4 @@
+(tests
+ (names test_pgx_value_ptime)
+ (package pgx_value_ptime)
+ (libraries alcotest pgx_value_ptime))

pgx_value_ptime/test/test_pgx_value_ptime.ml

@@ -0,0 +1,123 @@
+module Value = Pgx_value_ptime
+
+(* Show both an human-readable version of the date and the underlying
+   seconds/offset pair for the input datetime.*)
+let print_time (t, tz_offset_s) =
+  let sec = Ptime.to_float_s t
+  and txt = Ptime.to_rfc3339 t ~tz_offset_s ~frac_s:6 in
+  Printf.sprintf "<%s | Seconds: %f, Offset: %d>" txt sec tz_offset_s
+;;
+
+let value_testable =
+  let print_time value =
+    match Pgx.Value.to_string value with
+    | Some text -> text
+    | None -> "<None>"
+  in
+  let formatter ppf value = Format.pp_print_string ppf (print_time value) in
+  Alcotest.testable formatter ( = )
+;;
+
+let check_value = Alcotest.check value_testable
+
+let test_to_date _ =
+  let check_date = Alcotest.(check (triple int int int)) in
+  let value = Pgx.Value.of_string "2021-11-14" in
+  let expected = 2021, 11, 14 in
+  check_date "check date parsing" expected (Value.to_date_exn value);
+  let value = Pgx.Value.of_string "0900-06-13" in
+  let expected = 900, 6, 13 in
+  check_date "check date with leading zeros" expected (Value.to_date_exn value)
+;;
+
+let test_of_date _ =
+  let date = 2021, 11, 14 in
+  let expected = Pgx.Value.of_string "2021-11-14" in
+  check_value "check date rendering" expected (Value.of_date date);
+  let date = 900, 6, 13 in
+  let expected = Pgx.Value.of_string "0900-06-13" in
+  check_value "dates with leading zeros render properly" expected (Value.of_date date)
+;;
+
+let date_tests =
+  [ Alcotest.test_case "of_date renders a Ptime date to a Pgx Value" `Quick test_of_date
+  ; Alcotest.test_case "to_date parses a Pgx Value to a Ptime date" `Quick test_to_date
+  ]
+;;
+
+(* Show only the human-readable version of the date-time. *)
+let check_time =
+  let compare_times (t1, o1) (t2, o2) =
+    let tf1 = Ptime.to_float_s t1
+    and tf2 = Ptime.to_float_s t2 in
+    abs_float (tf1 -. tf2) < 1.0e-6 && o1 = o2
+  in
+  let time_testable =
+    Alcotest.testable
+      (fun ppf t -> Format.pp_print_string ppf (print_time t))
+      compare_times
+  in
+  Alcotest.check time_testable
+;;
+
+let test_time_of_string _ =
+  let hour = 3600 in
+  let hourf = 3600. in
+  let to_pt x = Ptime.of_float_s x |> Option.value ~default:Ptime.min in
+  check_time
+    "minimum time parses"
+    (Ptime.min, 0)
+    (Value.time_of_string "0000-01-01T00:00:00Z");
+  let pt = to_pt (12. *. hourf) in
+  check_time
+    "time with tz offset parses"
+    (pt, ~-4 * hour)
+    (Value.time_of_string "1970-01-01T08:00:00-04:00");
+  let pt = to_pt ((12. *. hourf) +. 0.12345) in
+  check_time
+    "a time with milliseconds parses"
+    (pt, 0)
+    (Value.time_of_string "1970-01-01T12:00:00.12345Z");
+  (* On linux, one can run "TZ='UTC' date -d @1458086118" in a shell to confirm this conversion is correct.*)
+  check_time
+    "a recent time parses"
+    (to_pt 1458086118., ~-4 * hour)
+    (Value.time_of_string "2016-03-15 19:55:18-04:00")
+;;
+
+let time_roundtrip str = Value.of_string str |> Value.to_time_exn
+
+let test_time_tz_handling _ =
+  let utc_t, tz_offset_s = Value.time_of_string "2016-03-15 19:55:18-04:00" in
+  check_time "without TZ" (utc_t, 0) (time_roundtrip "2016-03-15 23:55:18");
+  check_time "zulu" (utc_t, 0) (time_roundtrip "2016-03-15 23:55:18Z");
+  check_time "hour TZ" (utc_t, tz_offset_s) (time_roundtrip "2016-03-15 19:55:18-04");
+  check_time "full TZ" (utc_t, tz_offset_s) (time_roundtrip "2016-03-15 19:55:18-04:00")
+;;
+
+let test_time_conversion_roundtrip _ =
+  let print_time (t, tz_offset_s) = Ptime.to_rfc3339 t ~tz_offset_s ~frac_s:6 in
+  let expected_str = "2016-03-15T23:55:18.123456Z" in
+  Alcotest.(check string)
+    "parse-print"
+    expected_str
+    (time_roundtrip expected_str |> print_time);
+  let t, tz_offset_s = Value.time_of_string expected_str in
+  let actual = Value.of_time t ~tz_offset_s |> Value.to_time_exn in
+  check_time "print-parse" (t, tz_offset_s) actual
+;;
+
+let time_tests =
+  [ Alcotest.test_case "test time_of_string" `Quick test_time_of_string
+  ; Alcotest.test_case
+      "test time_of_string time zone handling"
+      `Quick
+      test_time_tz_handling
+  ; Alcotest.test_case
+      "test time conversion roundtrip"
+      `Quick
+      test_time_conversion_roundtrip
+  ]
+;;
+
+let () = Alcotest.run "pgx_async_conversions" [ "date", date_tests; "time", time_tests ]