diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..249d4c3 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +*~ +_build +_tests +*.native +*.byte diff --git a/.merlin b/.merlin new file mode 100644 index 0000000..91f6f1c --- /dev/null +++ b/.merlin @@ -0,0 +1,4 @@ +PKG alcotest + +S src +B _build/** diff --git a/Makefile b/Makefile index 35374a3..8daaaca 100644 --- a/Makefile +++ b/Makefile @@ -1,13 +1,21 @@ +.PHONY: build test install uninstall doc gh-pages clean + LIB=ISO8601 LIB_FILES=$(addprefix $(LIB)., a cmxa cma cmi) VERSION=0.2.4 +OCAMLBUILD=ocamlbuild -use-ocamlfind -classic-display + .INTERMEDIATE: $(LIB).odocl build: $(LIB_FILES) $(LIB_FILES): - ocamlbuild -I src $@ + $(OCAMLBUILD) $@ + +test: + $(OCAMLBUILD) test.native + ./test.native install: META $(LIB_FILES) ocamlfind install $(LIB) META $(addprefix _build/src/, $(LIB_FILES)) @@ -19,7 +27,7 @@ $(LIB).odocl: echo 'ISO8601' > $@ doc: $(LIB).odocl - ocamlbuild -I src $(LIB).docdir/index.html + $(OCAMLBUILD) $(LIB).docdir/index.html gh-pages: doc commitmsg="Documentation for $(VERSION) version." \ @@ -28,7 +36,4 @@ gh-pages: doc ghpup clean: - ocamlbuild -clean - -clean: - ocamlbuild -clean + $(OCAMLBUILD) -clean diff --git a/_tags b/_tags new file mode 100644 index 0000000..3ac7742 --- /dev/null +++ b/_tags @@ -0,0 +1,2 @@ +"src": include +"test": include diff --git a/opam b/opam index f2c39b6..e0700dd 100644 --- a/opam +++ b/opam @@ -20,10 +20,17 @@ bug-reports: "https://github.com/sagotch/ISO8601.ml/issues" build-doc: [ make "doc" ] +build-test: [ make "test" ] + build: [ make "build" ] install: [ make "install" ] remove: [ "ocamlfind" "remove" "ISO8601" ] -depends: [ "ocamlfind" ] +depends: [ + "ocamlfind" {build} + "ocamlbuild" {build} + "base-unix" + "alcotest" {test} +] diff --git a/src/ISO8601.ml b/src/ISO8601.ml index 018bfae..8e41227 100644 --- a/src/ISO8601.ml +++ b/src/ISO8601.ml @@ -13,9 +13,17 @@ 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 -> + (* TODO: this should be a real exception *) + if reqtime then assert false else (d, None) + | Some _ -> + let (t, tz) = time_tz_lex lexbuf in + match tz with + | None -> (d +. t, tz) + | Some tz -> + let t = d +. t in + let offt = fst (Unix.mktime (Unix.gmtime t)) in + (t -. (offt -. t), Some tz) let time_lex lexbuf = fst (time_tz_lex lexbuf) @@ -35,7 +43,6 @@ 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 @@ -43,7 +50,18 @@ module Permissive = struct (* 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 @@ -61,8 +79,21 @@ 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) @@ -80,42 +111,54 @@ module Permissive = struct 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 () - 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 diff --git a/src/ISO8601.mli b/src/ISO8601.mli index 6edb705..e3a74da 100644 --- a/src/ISO8601.mli +++ b/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,42 +61,56 @@ 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 val pp_date : Format.formatter -> float -> unit + val string_of_date_utc : float -> string val string_of_date : float -> string (** "%Y%M%D" format. *) + val pp_date_basic_utc : Format.formatter -> float -> unit val pp_date_basic : Format.formatter -> float -> unit + val string_of_date_basic_utc : float -> string val string_of_date_basic : float -> string (** "%h:%m:%s" format. *) + val pp_time_utc : Format.formatter -> float -> unit val pp_time : Format.formatter -> float -> unit + val string_of_time_utc : float -> string val string_of_time : float -> string (** "%h%m%s" format. *) + val pp_time_basic_utc : Format.formatter -> float -> unit val pp_time_basic : Format.formatter -> float -> unit + val string_of_time_basic_utc : float -> string val string_of_time_basic : float -> string (** "%Y-%M-%DT%h:%m:%s" format. *) + val pp_datetime_utc : Format.formatter -> float -> unit val pp_datetime : Format.formatter -> float -> unit + val string_of_datetime_utc : float -> string val string_of_datetime : float -> string (** "%Y%M%DT%h%m%s" format. *) + val pp_datetime_basic_utc : Format.formatter -> float -> unit val pp_datetime_basic : Format.formatter -> float -> unit + val string_of_datetime_basic_utc : float -> string 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 diff --git a/src/ISO8601_lexer.mll b/src/ISO8601_lexer.mll index fb05322..ad5e5ea 100644 --- a/src/ISO8601_lexer.mll +++ b/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 diff --git a/test/_tags b/test/_tags new file mode 100644 index 0000000..cd540c3 --- /dev/null +++ b/test/_tags @@ -0,0 +1 @@ +<*.*>: package(alcotest) diff --git a/test/test.ml b/test/test.ml new file mode 100644 index 0000000..ac62057 --- /dev/null +++ b/test/test.ml @@ -0,0 +1,198 @@ +(* + * Copyright (c) 2015 David Sheets + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) + +module Tm_struct : Alcotest.TESTABLE with type t = Unix.tm = struct + type t = Unix.tm + + let pp fmt tm = + let open Unix in + let s = Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02d" + (1900+tm.tm_year) (tm.tm_mon+1) tm.tm_mday + tm.tm_hour tm.tm_min tm.tm_sec + in + Format.pp_print_string fmt s + + let equal a b = + Unix.(a.tm_sec = b.tm_sec + && a.tm_min = b.tm_min + && a.tm_hour = b.tm_hour + && a.tm_mday = b.tm_mday + && a.tm_mon = b.tm_mon + && a.tm_year = b.tm_year) +end + +let tm_struct = (module Tm_struct : Alcotest.TESTABLE with type t = Unix.tm) + +type hemi = Neg | Pos +type tz = Local | Z | Tz of hemi * int * int + +let est = Tz (Neg, 5, 0) +let ist = Tz (Pos, 5, 30) +let vet = Tz (Neg, 4, 30) + +let time_tests f = [ + "before_1900", `Quick, f 1861 9 1 8 0 0 Local; + "before_epoch", `Quick, f 1969 1 1 0 0 1 Local; + "nowish", `Quick, f 2015 12 27 0 0 1 Local; + "before_1900_z", `Quick, f 1861 9 1 8 0 0 Z; + "before_epoch_z", `Quick, f 1969 1 1 0 0 1 Z; + "nowish_z", `Quick, f 2015 12 27 0 0 1 Z; + "before_1900_est", `Quick, f 1861 9 1 8 0 0 est; + "before_epoch_est", `Quick, f 1969 1 1 0 0 1 est; + "nowish_est", `Quick, f 2015 12 27 0 0 1 est; + "before_1900_ist", `Quick, f 1861 9 1 8 0 0 ist; + "before_epoch_ist", `Quick, f 1969 1 1 0 0 1 ist; + "nowish_ist", `Quick, f 2015 12 27 0 0 1 ist; + "before_1900_vet", `Quick, f 1861 9 1 8 0 0 vet; + "before_epoch_vet", `Quick, f 1969 1 1 0 0 1 vet; + "nowish_vet", `Quick, f 2015 12 27 0 0 1 vet; +] + +let fixed_time_tests f = [ + "fixed_unix_time_nowish_utc", `Quick, + f 1451407335. 0. "2015-12-29T16:42:15Z"; + "fixed_unix_time_nowish_est", `Quick, + f 1451407335. (-18000.) "2015-12-29T11:42:15-05:00"; + "fixed_unix_time_nowish_ist", `Quick, + f 1451407335. 19800. "2015-12-29T22:12:15+05:30"; + "fixed_unix_time_nowish_vet", `Quick, + f 1451407335. (-16200.) "2015-12-29T12:12:15-04:30"; +] + +let str_tm year month day hour minute second tz = + let str = Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02d%s" + year month day hour minute second + (match tz with + | Local -> "" + | Z -> "Z" + | Tz (Neg, hr, mn) -> Printf.sprintf "-%02d:%02d" hr mn + | Tz (Pos, hr, mn) -> Printf.sprintf "+%02d:%02d" hr mn + ) + in + let tm = Unix.({ + tm_sec = second; + tm_min = minute; + tm_hour = hour; + tm_mday = day; + tm_mon = month - 1; + tm_year = year - 1900; + tm_wday = 0; + tm_yday = 0; + tm_isdst = false; + }) in + let t, _ = Unix.mktime tm in + let t', _ = Unix.mktime (Unix.gmtime t) in + let local_unix_time = t -. (t' -. t) in + let tm = match tz with + | Local -> tm + | Z -> snd Unix.(mktime (gmtime local_unix_time)) + | Tz (Neg, hr, mn) -> + let t = local_unix_time +. (float_of_int ((hr * 3600) + (mn * 60))) in + snd Unix.(mktime (gmtime t)) + | Tz (Pos, hr, mn) -> + let t = local_unix_time -. (float_of_int ((hr * 3600) + (mn * 60))) in + snd Unix.(mktime (gmtime t)) + in + (str, tm) + +let erange = Unix.Unix_error (Unix.ERANGE, "mktime", "") + +let parse_test year month day hour minute second tz () = + if year < 1900 + then Alcotest.check_raises "< 1900 is ERANGE" erange (fun () -> + ignore (ISO8601.Permissive.datetime "1861-01-01T00:00:00Z") + ) + else + let str, tm = str_tm year month day hour minute second tz in + let parsed = ISO8601.Permissive.datetime str in + let output = match tz with + | Local -> Unix.localtime parsed + | Z | Tz _ -> Unix.gmtime parsed + in + Alcotest.(check tm_struct ("parse "^str) tm output) + +let parse_fixed_unix_time unix_time tz s () = + let parsed = int_of_float (ISO8601.Permissive.datetime s) in + Alcotest.(check int ("parse "^s) (int_of_float unix_time) parsed) + +let parse_tests = + time_tests parse_test @ fixed_time_tests parse_fixed_unix_time + +let string_of_datetime unix_time = function + | Local -> ISO8601.Permissive.string_of_datetime unix_time + | Z -> ISO8601.Permissive.string_of_datetimezone (unix_time,0.) + | Tz (Neg,hr,mn) -> + let tz = float_of_int (- (hr * 3600 + mn * 60)) in + ISO8601.Permissive.string_of_datetimezone (unix_time, tz) + | Tz (Pos,hr,mn) -> + let tz = float_of_int (hr * 3600 + mn * 60) in + ISO8601.Permissive.string_of_datetimezone (unix_time, tz) + +let print_test year month day hour minute second tz () = + (* We use Unix.mktime to find the epoch time but with year < 1900 it + will error with ERANGE. *) + if year < 1900 + then () + else + let str, tm = str_tm year month day hour minute second tz in + let unix_time, _ = Unix.mktime tm in + let unix_time = match tz with + | Local -> unix_time + | Z | Tz _ -> + let offt, _ = Unix.mktime (Unix.gmtime unix_time) in + unix_time -. (offt -. unix_time) + in + let output = string_of_datetime unix_time tz in + Alcotest.(check string ("print "^str) str output) + +let print_fixed_unix_time unix_time tz s () = + let output = ISO8601.Permissive.string_of_datetimezone (unix_time, tz) in + Alcotest.(check string ("print "^s) s output) + +let print_tests = + time_tests print_test @ fixed_time_tests print_fixed_unix_time + +let rt_test year month day hour minute second tz () = + if year < 1900 + then Alcotest.check_raises "< 1900 is ERANGE" erange (fun () -> + ignore (ISO8601.Permissive.datetime "1861-01-01T00:00:00") + ) + else + let str, _ = str_tm year month day hour minute second tz in + let output = string_of_datetime (ISO8601.Permissive.datetime str) tz in + Alcotest.(check string ("roundtrip "^str) str output) + +let rt_fixed_unix_time unix_time tz s () = + let output = ISO8601.Permissive.(string_of_datetimezone (datetime s, tz)) in + Alcotest.(check string ("roundtrip "^s) s output); + let output = int_of_float ISO8601.Permissive.( + datetime (string_of_datetimezone (unix_time, tz)) + ) in + let unix_time = int_of_float unix_time in + Alcotest.(check int ("roundtrip "^string_of_int unix_time) unix_time output) + +let rt_tests = + time_tests rt_test @ fixed_time_tests rt_fixed_unix_time + +let suites = [ + "parse", parse_tests; + "print", print_tests; + "rt", rt_tests; +] + +;; +Alcotest.run "ISO8601" suites