updated PR #5

.merlin

@@ -0,0 +1,4 @@
+PKG alcotest
+
+S src
+B _build/**

_tags

@@ -0,0 +1,2 @@
+"src": include
+"test": include

src/ISO8601.ml

@@ -13,9 +13,18 @@ module Permissive = struct
     let datetime_tz_lex ?(reqtime=true) lexbuf =
       let d = date_lex lexbuf in
       match Lexer.delim lexbuf with
-      | None -> if reqtime then assert false else (d, None)
-      | Some _ -> let (t, tz) = time_tz_lex lexbuf in
-                  (d +. t, tz)
+      | None ->
+        if reqtime then failwith "time must be specified"
+        else (d, None)
+      | Some _ ->
+        let (t, tz) = time_tz_lex lexbuf in
+        match tz with
+        | None -> (d +. t, tz)
+        | Some tz ->
+          (* obtain the daylight saving time for the given TZ and day *)
+          let td = d +. floor t in
+          let offt = fst (Unix.mktime (Unix.gmtime td)) -. td in
+          ((d +. t) -. offt, Some tz)
 
     let time_lex lexbuf =
       fst (time_tz_lex lexbuf)
@@ -35,16 +44,22 @@ module Permissive = struct
     let datetime ?(reqtime=true) s =
       datetime_lex ~reqtime:reqtime (Lexing.from_string s)
 
-    (* FIXME: possible loss of precision. *)
     let pp_format fmt format x tz =
-
       let open Unix in
       let open Format in
 
       (* Be careful, do not forget to print timezone if there is one,
        * or information printed will be wrong. *)
-      let x = gmtime (x -. tz) in
-
+      let x = match tz with
+        | None    -> localtime x
+        | Some tz -> gmtime (x +. tz)
+      in
+      let print_tz_hours fmt tz =
+        fprintf fmt "%0+3d" (Pervasives.truncate (tz /. 3600.))
+      in
+      let print_tz_minutes fmt tz =
+        fprintf fmt "%02.0f" (mod_float (abs_float (tz /. 60.)) 60.0)
+      in
       let conversion =
         let pad2 = fprintf fmt "%02d" in
         let pad4 = fprintf fmt "%04d" in
@@ -61,61 +76,90 @@ module Permissive = struct
         | 's' -> pad2 x.tm_sec
 
         (* Timezone *)
-        | 'Z' -> fprintf fmt "%0+3.0f" (tz /. 3600.) (* Hours *)
-        | 'z' -> fprintf fmt "%02.0f" (mod_float (abs_float (tz /. 60.)) 60.0) (* Minutes *)
+        | 'Z' -> begin match tz with (* with colon *)
+          | None    -> ()
+          | Some 0. -> fprintf fmt "Z"
+          | Some tz ->
+            print_tz_hours fmt tz;
+            fprintf fmt ":";
+            print_tz_minutes fmt tz
+        end
+        | 'z' -> begin match tz with (* without colon *)
+          | None    -> ()
+          | Some 0. -> fprintf fmt "Z"
+          | Some tz ->
+            print_tz_hours fmt tz;
+            print_tz_minutes fmt tz
+        end
 
         | '%' -> pp_print_char fmt '%'
         |  c  -> failwith ("Bad format: %" ^ String.make 1 c)
 
       in
 
       let len = String.length format in
+      (* parse input format string *)
       let rec parse_format i =
         if i = len then ()
         else match String.get format i with
              | '%' -> conversion (String.get format (i + 1)) ;
                       parse_format (i + 2)
              |  c  -> pp_print_char fmt c ;
-                      parse_format (i + 1) in
-
+               parse_format (i + 1)
+      in
       parse_format 0
 
-    let pp_date fmt x = pp_format fmt "%Y-%M-%D" x 0.
+    let pp_date_utc fmt x = pp_format fmt "%Y-%M-%D" x (Some 0.)
+    let pp_date     fmt x = pp_format fmt "%Y-%M-%D" x None
 
-    let pp_time fmt x = pp_format fmt "%h:%m:%s" x 0.
+    let pp_time_utc fmt x = pp_format fmt "%h:%m:%s" x (Some 0.)
+    let pp_time     fmt x = pp_format fmt "%h:%m:%s" x None
 
-    let pp_datetime fmt x = pp_format fmt "%Y-%M-%DT%h:%m:%s" x 0.
+    let pp_datetime_utc fmt x = pp_format fmt "%Y-%M-%DT%h:%m:%s" x (Some 0.)
+    let pp_datetime     fmt x = pp_format fmt "%Y-%M-%DT%h:%m:%s" x None
 
     let pp_datetimezone fmt (x, tz) =
-      pp_format fmt "%Y-%M-%DT%h:%m:%s%Z:%z" x tz
+      pp_format fmt "%Y-%M-%DT%h:%m:%s%Z" x (Some tz)
 
-    let pp_date_basic fmt x = pp_format fmt "%Y%M%D" x 0.
+    let pp_date_basic_utc fmt x = pp_format fmt "%Y%M%D" x (Some 0.)
+    let pp_date_basic     fmt x = pp_format fmt "%Y%M%D" x None
 
-    let pp_time_basic fmt x = pp_format fmt "%h%m%s" x 0.
+    let pp_time_basic_utc fmt x = pp_format fmt "%h%m%s" x (Some 0.)
+    let pp_time_basic     fmt x = pp_format fmt "%h%m%s" x None
 
-    let pp_datetime_basic fmt x = pp_format fmt "%Y%M%DT%h%m%s" x 0.
+    let pp_datetime_basic_utc fmt x = pp_format fmt "%Y%M%DT%h%m%s" x (Some 0.)
+    let pp_datetime_basic     fmt x = pp_format fmt "%Y%M%DT%h%m%s" x None
 
     let pp_datetimezone_basic fmt (x, tz) =
-      pp_format fmt "%Y%M%DT%h%m%s%Z%z" x tz
+      pp_format fmt "%Y%M%DT%h%m%s%z" x (Some tz)
 
     let string_of_aux printer x =
-      ignore (Format.flush_str_formatter ()) ;
-      printer Format.str_formatter x ;
-      Format.flush_str_formatter ()
+      (* use a local buffer, [str_formatter] is not recommended *)
+      let buf = Buffer.create 32 in
+      let fmt = Format.formatter_of_buffer buf in
+      printer fmt x ;
+      Format.pp_print_flush fmt ();
+      Buffer.contents buf
 
-    let string_of_date = string_of_aux pp_date
+    let string_of_date_utc = string_of_aux pp_date_utc
+    let string_of_date     = string_of_aux pp_date
 
-    let string_of_time = string_of_aux pp_time
+    let string_of_time_utc = string_of_aux pp_time_utc
+    let string_of_time     = string_of_aux pp_time
 
-    let string_of_datetime = string_of_aux pp_datetime
+    let string_of_datetime_utc = string_of_aux pp_datetime_utc
+    let string_of_datetime     = string_of_aux pp_datetime
 
     let string_of_datetimezone = string_of_aux pp_datetimezone
 
-    let string_of_date_basic = string_of_aux pp_date_basic
+    let string_of_date_basic_utc = string_of_aux pp_date_basic_utc
+    let string_of_date_basic     = string_of_aux pp_date_basic
 
-    let string_of_time_basic = string_of_aux pp_time_basic
+    let string_of_time_basic_utc = string_of_aux pp_time_basic_utc
+    let string_of_time_basic     = string_of_aux pp_time_basic
 
-    let string_of_datetime_basic = string_of_aux pp_datetime_basic
+    let string_of_datetime_basic_utc = string_of_aux pp_datetime_basic_utc
+    let string_of_datetime_basic     = string_of_aux pp_datetime_basic
 
     let string_of_datetimezone_basic = string_of_aux pp_datetimezone_basic
 

src/ISO8601.mli

@@ -53,8 +53,6 @@ module Permissive : sig
         to [fmt], and conversion specifications, each of which causes
         conversion and printing of (a part of) [x] or [tz].
 
-        {b If you do not want to use a timezone, set it to 0.}
-
         Conversion specifications have the form [%X], where X can be:
 
         - [Y]: Year
@@ -63,43 +61,106 @@ module Permissive : sig
         - [h]: Hours
         - [m]: Minutes
         - [s]: Seconds
-        - [Z]: Hours of [tz] offset (with its sign)
-        - [z]: Minutes of [tz] offset (without sign)
+        - [Z]: Hours and minutes of [tz] offset (with sign), colon separated,
+               'Z' if [tz] offset is 0; if [tz] is None, print nothing
+        - [z]: Hours and minutes of [tz] offset (with sign), without colon,
+               'Z' if [tz] offset is 0; if [tz] is None, print nothing
         - [%]: The '%' character
 
      *)
-    val pp_format : Format.formatter -> string -> float -> float -> unit
+    val pp_format : Format.formatter -> string -> float -> float option -> unit
 
     (** "%Y-%M-%D" format. *)
+
+    val pp_date_utc : Format.formatter -> float -> unit
+    (** Prints the date in UTC timezone
+        @since 0.3.0 *)
+
     val pp_date : Format.formatter -> float -> unit
+
+    val string_of_date_utc : float -> string
+    (** Prints the date in UTC timezone
+        @since 0.3.0 *)
+
     val string_of_date : float -> string
 
-    (** "%Y%M%D" format. *)
+    (** {2 "%Y%M%D" format.} *)
+
+    val pp_date_basic_utc : Format.formatter -> float -> unit
+    (** Prints the date in UTC timezone
+        @since 0.3.0 *)
+
     val pp_date_basic : Format.formatter -> float -> unit
+
+    val string_of_date_basic_utc : float -> string
+    (** Prints the date in UTC timezone
+        @since 0.3.0 *)
+
     val string_of_date_basic : float -> string
 
-    (** "%h:%m:%s" format. *)
+    (** {2 "%h:%m:%s" format.} *)
+
+    val pp_time_utc : Format.formatter -> float -> unit
+    (** Prints the time in UTC timezone
+        @since 0.3.0 *)
+
     val pp_time : Format.formatter -> float -> unit
+
+    val string_of_time_utc : float -> string
+    (** Prints the time in UTC timezone
+        @since 0.3.0 *)
+
     val string_of_time : float -> string
 
-    (** "%h%m%s" format. *)
+    (** {2 "%h%m%s" format.} *)
+
+    val pp_time_basic_utc : Format.formatter -> float -> unit
+    (** @since 0.3.0 *)
+
     val pp_time_basic : Format.formatter -> float -> unit
+
+    val string_of_time_basic_utc : float -> string
+    (** @since 0.3.0 *)
+
     val string_of_time_basic : float -> string
 
-    (** "%Y-%M-%DT%h:%m:%s" format. *)
+    (** {2 "%Y-%M-%DT%h:%m:%s" format.} *)
+
+    val pp_datetime_utc : Format.formatter -> float -> unit
+    (** Prints the datetime in the UTC timezone.
+        @since 0.3.0 *)
+
     val pp_datetime : Format.formatter -> float -> unit
+
+    val string_of_datetime_utc : float -> string
+    (** @since 0.3.0 *)
+
     val string_of_datetime : float -> string
 
     (** "%Y%M%DT%h%m%s" format. *)
+
+    val pp_datetime_basic_utc : Format.formatter -> float -> unit
+    (** Prints the datetime in the UTC timezone.
+        @since 0.3.0 *)
+
     val pp_datetime_basic : Format.formatter -> float -> unit
+
+    val string_of_datetime_basic_utc : float -> string
+    (** Prints the datetime in the UTC timezone.
+        @since 0.3.0 *)
+
     val string_of_datetime_basic : float -> string
 
-    (** "%Y-%M-%DT%h:%m:%s%Z:%z" format. *)
+    (** "%Y-%M-%DT%h:%m:%s%Z" format. *)
+
     val pp_datetimezone : Format.formatter -> (float * float) -> unit
+
     val string_of_datetimezone : (float * float) -> string
 
-    (** "%Y%M%DT%h%m%s%Z%z" format. *)
+    (** "%Y%M%DT%h%m%s%z" format. *)
+
     val pp_datetimezone_basic : Format.formatter -> (float * float) -> unit
+
     val string_of_datetimezone_basic : (float * float) -> string
 
 end

src/ISO8601_lexer.mll

@@ -3,19 +3,17 @@
 
   (* Date helpers *)
   let mkdate y m d =
-    let (t, tm) = Unix.mktime {
-                      Unix.tm_sec = 0 ;
-                      tm_min = 0 ;
-                      tm_hour = 0 ;
-                      tm_mday = d ;
-                      tm_mon = m - 1 ;
-                      tm_year = y - 1900 ;
-                      tm_wday = -1 ;
-                      tm_yday = -1 ;
-                      tm_isdst = false ; } in
-    let offset = fst (Unix.mktime (Unix.gmtime 0. )) in
-    (* FIXME: Ensure the daylight saving time correction is right. *)
-    t -. offset +. (if tm.Unix.tm_isdst then 3600. else 0.)
+    fst (Unix.mktime {
+      Unix.tm_sec = 0 ;
+      tm_min = 0 ;
+      tm_hour = 0 ;
+      tm_mday = d ;
+      tm_mon = m - 1 ;
+      tm_year = y - 1900 ;
+      tm_wday = -1 ;
+      tm_yday = -1 ;
+      tm_isdst = false ;
+    })
 
   let ymd y m d = mkdate (int y) (int m) (int d)
   let ym y m = mkdate (int y) (int m) 1

tests/ISO8601_PARSER.ml

@@ -1,15 +1,19 @@
-let test p fn input expected =
+let with_utc = Utils.with_utc
+
+let test ~p fn input expected =
   let result = fn input in
-  let assert_equal = OUnit.assert_equal
-                       ~cmp:(OUnit.cmp_float ~epsilon:Pervasives.epsilon_float)
-                       ~printer:p in
-  OUnit.(>::) input (fun _ -> assert_equal expected result)
+  let assert_equal =
+    OUnit.assert_equal
+      ~cmp:(OUnit.cmp_float ~epsilon:Pervasives.epsilon_float)
+      ~printer:(fun x -> Printf.sprintf "%.6f (as %s)" x (p x))
+  in
+  OUnit.(>::) input (fun () -> with_utc (fun () -> assert_equal expected result))
 
-let date = test ISO8601.Permissive.string_of_date ISO8601.Permissive.date
+let date = test ~p:ISO8601.Permissive.string_of_datetime_utc ISO8601.Permissive.date
 
-let time = test ISO8601.Permissive.string_of_time ISO8601.Permissive.time
+let time = test ~p:ISO8601.Permissive.string_of_time_utc ISO8601.Permissive.time
 
-let datetime = test ISO8601.Permissive.string_of_datetime ISO8601.Permissive.datetime
+let datetime = test ~p:ISO8601.Permissive.string_of_datetime_utc ISO8601.Permissive.datetime
 
 (* Parser tests *)
 let suite =
@@ -62,4 +66,10 @@ let suite =
           [
             datetime "2015-02-15T11:55" (mkdatetime 2015 02 15 11 55 0) ;
           ] ;
+    OUnit.(>:::) "[DATETIME WITH TIMEZONE]"
+      [
+        datetime "1979-05-27T07:32:00Z" (mkdatetime 1979 05 27 7 32 0);
+        datetime "1979-05-27T00:32:00-07:00" (mkdatetime 1979 05 27 7 32 0);
+        datetime "1979-05-27T00:32:00.999999-07:00" (mkdatetime 1979 05 27 7 32 0 +. 0.999999);
+      ];
   ]

tests/ISO8601_PRINTER.ml

@@ -4,11 +4,11 @@ let test (fn : float -> string) (input : float) (expected : string)  =
   OUnit.(>::) (string_of_float input)
         (fun _ -> assert_equal expected result)
 
-let date = test ISO8601.Permissive.string_of_date
+let date = test ISO8601.Permissive.string_of_date_utc
 
-let time = test ISO8601.Permissive.string_of_time
+let time = test ISO8601.Permissive.string_of_time_utc
 
-let datetime = test ISO8601.Permissive.string_of_datetime
+let datetime = test ISO8601.Permissive.string_of_datetime_utc
 
 let datetimezone input expected =
   let assert_equal = OUnit.assert_equal ~printer:(fun x -> x) in
@@ -40,7 +40,7 @@ let suite =
           ] ;
     OUnit.(>:::) "[PRINTER DATETIMEZONE]"
           [
-            datetimezone (0., 0.) "1970-01-01T00:00:00+00:00" ;
-            datetimezone (296638320., 0.) "1979-05-27T07:32:00+00:00"
+            datetimezone (0., 0.) "1970-01-01T00:00:00Z" ;
+            datetimezone (296638320., 0.) "1979-05-27T07:32:00Z"
           ] ;
   ]

tests/ISO8601_TEST.ml

@@ -5,4 +5,5 @@ let suite = OUnit.(>:::) "ISO8601" [
 ]
 
 let _ =
-  OUnit.run_test_tt_main suite
+  ignore (OUnit.run_test_tt_main suite : _ list);
+  ()