(*---------------------------------------------------------------------------*
  IMPLEMENTATION  cf_stdtime.ml

  Copyright (c) 2003-2006, James H. Woodyatt
  All rights reserved.

  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:

    Redistributions of source code must retain the above copyright
    notice, this list of conditions and the following disclaimer.

    Redistributions in binary form must reproduce the above copyright
    notice, this list of conditions and the following disclaimer in
    the documentation and/or other materials provided with the
    distribution

  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  OF THE POSSIBILITY OF SUCH DAMAGE. 
 *---------------------------------------------------------------------------*)

type t = {
    year: int;    	(* -2937947 .. 2941664, 1 BC = 0 *)
    month: int;    	(* january=1 .. december=12 *)
    day: int;    	(* 1 .. 31 *)
    hour: int;    	(* 0 .. 23 *)
    minute: int;    (* 0 .. 59 *)
    second: int;    (* 0 .. 60, 60=leap second *)
}

let sixty_ = Int64.of_int 60

let magic58486_ = Int64.of_int 58486
let magic53375995543064_ = Int64.of_string "53375995543064"

let secs_per_day_ = Int64.of_int 86400

let utc_of_tai64 ?wday ?yday mark =
    let leap, mark = Cf_tai64.leapsec_sub mark in
    let u = Cf_tai64.sub mark Cf_tai64.first in
    let u = Int64.add u magic58486_ in
    let s = Int64.rem u secs_per_day_ in
    let second =
        if leap then 60 else (Int64.to_int (Int64.rem s sixty_))
    in
    let s = Int64.div s sixty_ in
    let minute = (Int64.to_int (Int64.rem s sixty_)) in
    let s = Int64.div s sixty_ in
    let hour = Int64.to_int s in
    let u = Int64.div u secs_per_day_ in
    let u = Int64.sub u magic53375995543064_ in
    let mjd = Int64.to_int u in
    let year, month, day = Cf_gregorian.of_mjd ?wday ?yday mjd in {
        year = year;
        month = month;
        day = day;
        hour = hour;
        minute = minute;
        second = second;
    }

let utc_to_tai64_unsafe ~year ~month ~day ~hour ~minute ~second =
    let sec = ((((hour * 60) + minute)) * 60) + second in
    let mjd = Cf_gregorian.to_mjd ~year ~month ~day in
    let s64 = Int64.mul (Int64.of_int mjd) secs_per_day_ in
    let s64 = Int64.add s64 (Int64.of_int sec) in
    let tai = Cf_tai64.add_int64 Cf_tai64.mjd_epoch s64 in
    Cf_tai64.leapsec_add tai (second = 60)

let utc_to_tai64 ~year ~month ~day ~hour ~minute ~second =
    if not (Cf_gregorian.is_valid ~year ~month ~day) then
        invalid_arg "Cf_stdtime.utc_to_tai64: not valid gregorian date.";
    if hour < 0 || hour > 23 ||
    minute < 0 || minute > 59 ||
    second < 0 || second > 60 then
        invalid_arg "Cf_stdtime.utc_to_tai64: not valid wallclock time.";
    let sec = ((((hour * 60) + minute)) * 60) + second in
    let mjd = Cf_gregorian.to_mjd ~year ~month ~day in
    let s64 = Int64.mul (Int64.of_int mjd) secs_per_day_ in
    let s64 = Int64.add s64 (Int64.of_int sec) in
    let tai = Cf_tai64.add_int64 Cf_tai64.mjd_epoch s64 in
    if second < 60 then
        Cf_tai64.leapsec_add tai false
    else
        let v = Cf_tai64.leapsec_add tai true in
        let leap, _ = Cf_tai64.leapsec_sub tai in
        if not leap then
            invalid_arg "Cf_stdtime.utc_to_tai64: unrecorded leap second.";
        v

(*--- End of File [ cf_stdtime.ml ] ---*)
