unikernel/duniverse/pgx/pgx_value_core/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_core)
+ (libraries core_kernel pgx)
+ |} ^ preprocess ^ {|)
+|}

unikernel/duniverse/pgx/pgx_value_core/src/pgx_value_core.ml

@@ -0,0 +1,63 @@
+open Core_kernel
+include Pgx.Value
+
+let of_time t =
+  (*
+    Postgres behaves differently depending on whether the timestamp data type
+    includes the timezone or not:
+
+    Without timezone all inserted timezones are ignored
+    2016-06-07 15:37:46 (no timezone)
+    2016-06-07 15:37:46Z (utc timezone)
+    2016-06-07 15:37:46-04 (local timezone)
+    Get inserted as
+    2016-06-07 15:37:46
+
+    With timezones:
+    2016-06-07 15:37:46 (no timezone) -> 2016-06-07 15:37:46-04
+    2016-06-07 15:37:46Z (utc timezone) -> 2016-06-07 11:37:46-04
+    2016-06-07 15:37:46-04 (local timezone) -> 2016-06-07 15:37:46-04
+  *)
+  Time.to_string_abs ~zone:Time.Zone.utc t |> Pgx.Value.of_string
+;;
+
+let to_time' =
+  (*
+       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.
+       Without these formattings Time.of_string fails spectacularly
+    *)
+  let open Re in
+  let tz = seq [ alt [ char '-'; char '+' ]; digit; digit ] in
+  let utctz = seq [ char 'Z'; eol ] |> compile in
+  let localtz_no_min = seq [ tz; eol ] |> compile in
+  let localtz = seq [ tz; char ':'; digit; digit; eol ] |> compile in
+  fun s ->
+    Time.of_string
+    @@
+    match matches utctz s, matches localtz s, matches localtz_no_min s with
+    | [], [], [] -> s ^ "Z"
+    | _, [], [] -> s
+    | [], _, [] -> s
+    | [], [], _ -> s ^ ":00"
+    (* It either finishes in one of the patterns above or it doesn't *)
+    | _ -> convert_failure "time" s
+;;
+
+let to_time_exn v = Pgx.Value.to_string_exn v |> to_time'
+let to_time v = Pgx.Value.to_string v |> Option.map ~f:to_time'
+let of_date d = Date.to_string d |> Pgx.Value.of_string
+let to_date' = Date.of_string
+let to_date_exn v = Pgx.Value.to_string_exn v |> to_date'
+let to_date v = Pgx.Value.to_string v |> Option.map ~f:to_date'

unikernel/duniverse/pgx/pgx_value_core/src/pgx_value_core.mli

@@ -0,0 +1,14 @@
+(** Pgx_value types using Core_kernel's Date and Time modules *)
+open Core_kernel
+
+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 : Date.t -> t
+val to_date_exn : t -> Date.t
+val to_date : t -> Date.t option
+val of_time : Time.t -> t
+val to_time_exn : t -> Time.t
+val to_time : t -> Time.t option

unikernel/duniverse/pgx/pgx_value_core/test/dune

@@ -0,0 +1,4 @@
+(tests
+ (names test_pgx_value_core)
+ (package pgx_value_core)
+ (libraries alcotest pgx_value_core))

unikernel/duniverse/pgx/pgx_value_core/test/test_pgx_value_core.ml

@@ -0,0 +1,50 @@
+open Core_kernel
+module Value = Pgx_value_core
+
+let time_roundtrip str = Value.of_string str |> Value.to_time_exn
+let printer = Time.to_string_abs ~zone:Time.Zone.utc
+
+let time_testable =
+  Alcotest.testable (fun ppf t -> Format.pp_print_string ppf (printer t)) Time.equal
+;;
+
+let check_time = Alcotest.check time_testable
+let check_string = Alcotest.(check string)
+
+let test_time_of_string _ =
+  let expected = Time.of_string "2016-03-15 19:55:18.123456-04:00" in
+  check_time "without TZ" expected (time_roundtrip "2016-03-15 23:55:18.123456");
+  check_time "zulu" expected (time_roundtrip "2016-03-15 23:55:18.123456Z");
+  check_time "hour TZ" expected (time_roundtrip "2016-03-15 19:55:18.123456-04");
+  check_time "full TZ" expected (time_roundtrip "2016-03-15 19:55:18.123456-04:00")
+;;
+
+let test_time_of_string_no_ms _ =
+  let expected = Time.of_string "2016-03-15 19:55:18-04:00" in
+  check_time "without TZ" expected (time_roundtrip "2016-03-15 23:55:18");
+  check_time "zulu" expected (time_roundtrip "2016-03-15 23:55:18Z");
+  check_time "hour TZ" expected (time_roundtrip "2016-03-15 19:55:18-04");
+  check_time "full TZ" expected (time_roundtrip "2016-03-15 19:55:18-04:00")
+;;
+
+let test_time_conversion_roundtrip _ =
+  let expected_str = "2016-03-15 23:55:18.123456Z" in
+  check_string "parse-print" expected_str (time_roundtrip expected_str |> printer);
+  let expected_time = Time.of_string expected_str in
+  check_time "print-parse" expected_time (Value.of_time expected_time |> Value.to_time_exn)
+;;
+
+let time_tests =
+  [ Alcotest.test_case "test time_of_string" `Quick test_time_of_string
+  ; Alcotest.test_case
+      "test time_of_string no milliseconds"
+      `Quick
+      test_time_of_string_no_ms
+  ; Alcotest.test_case
+      "test time conversion roundtrip"
+      `Quick
+      test_time_conversion_roundtrip
+  ]
+;;
+
+let () = Alcotest.run "pgx_async_conversions" [ "time", time_tests ]