(**
   カレンダーモジュール
   
   @author Satoshi Ogasawara, IT Planning Inc.
   @version $Id: calendar.ml,v 1.2 2007/05/21 05:43:00 ogasawara Exp $
*)   
(*   
   Copyright (c) 2007 IT Planning inc. All Rights Reserved.

   Permission is hereby granted, free of charge, to any person obtaining
   a copy of this software and associated documentation files (the
   "Software"), to deal in the Software without restriction, including
   without limitation the rights to use, copy, modify, merge, publish,
   distribute, sublicense, and/or sell copies of the Software, and to
   permit persons to whom the Software is furnished to do so, subject to
   the following conditions:
   
   The above copyright notice and this permission notice shall be
   included in all copies or substantial portions of the Software.
   
   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
   CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
   TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
   SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*)
open Unix

(** カレンダー型(時刻も含む) *)
type t = Unix.tm

(** 現在の日時 *)
let today () =
  localtime (time ())

(** 指定された日の次の日を返す *)
let next_day day =
  let _, next = mktime { day with tm_mday = day.tm_mday + 1 } in  
  next

(** 指定された日のn年後を返す *)
let add_years day n =
  let _, nd = mktime { day with tm_year = day.tm_year + n } in
  nd

(** 指定された日のn週間後を返す *)
let add_weeks day n =
  let _, nd = mktime { day with tm_mday = day.tm_mday + 7 * n } in
  nd

(** 指定された日のn日後を返す *)
let add_days day n =
  let _, nd = mktime { day with tm_mday = day.tm_mday + n } in  
  nd

(** 指定された時刻のn時間後を返す *)
let add_hour day n =
  if day.tm_hour + n >= 24 then
    let hour = day.tm_hour + n - 24 in
    { (add_days day 1) with tm_hour = hour }
  else
    { day with tm_hour = day.tm_hour + n }

(** 指定された時刻のn分後を返す *)
let add_minutes day n =
  if day.tm_min + n >= 60 then
    let min = day.tm_min + n - 60 in
    { (add_hour day 1) with tm_min = min }
  else
    { day with tm_min = day.tm_min + n }

(** 年月日を指定して日付を作る *)
let make year month day = 
  { tm_sec = 0; tm_min = 0; tm_hour = 0;
    tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;
    tm_wday = 0; tm_yday = 0; tm_isdst = false; }

(** make のタプル版 *)
let of_tuple (year, month, day) = 
  make year month day

let dsep = Str.regexp_string "/"

(** 
    yyyy/mm/dd形式の文字列から日付を作る.
    形式が合わないと、Invalid_argumentがあがる.
 *)
let parse str = 
  try
    let 
	year :: month :: day :: [] = Str.split dsep str 
    in
    { tm_sec = 0; 
      tm_min = 0; 
      tm_hour = 0;
      tm_mday = int_of_string day; 
      tm_mon = (int_of_string month) - 1; 
      tm_year = (int_of_string year) - 1900;
      tm_wday = 0; tm_yday = 0; tm_isdst = false; }
  with
    _ -> raise (Invalid_argument str)
      
(** 指定された日付の年を得る　*)    
let year day =
  day.tm_year + 1900

(** 指定された日付の付きを得る. 1月が1で12月が12 *)
let month day =
  day.tm_mon + 1

(** 年, 月, 日のタプルを返す *)
let to_tuple day = (year day, month day, day.tm_mday)

(** yyyy/mm/dd HH:MM:SS 形式の文字列を返す *)
let to_string day = 
  Format.sprintf "%d/%d/%d %d:%d:%d"
    (year day)
    (month day)
    day.tm_mday
    day.tm_hour
    day.tm_min
    day.tm_sec

(** 日付の比較. d1よりd2が古い日付だと-1,同じなら0,それ以外なら1を返す *)
let compare d1 d2 =
  let clist = [ (d1.tm_year, d2.tm_year);
		(d1.tm_mon, d2.tm_mon);
		(d1.tm_mday, d2.tm_mday);
		(d1.tm_hour, d2.tm_hour);
		(d1.tm_min, d2.tm_min);
		(d1.tm_sec, d2.tm_sec); ]
  in
  let comp r (a, b) =
    if r = 0 then compare a b
    else r
  in
  List.fold_left comp 0 clist

(** 指定された二つの日付の大きい方を返す. *)
let max d1 d2 =
  let i = compare d1 d2 in
  if i < 0 then d2
  else d1

(** 指定された二つの日付の小さい方を返す *)
let min d1 d2 =
  let i = compare d1 d2 in
  if i < 0 then d1
  else d2

(** 指定された二つの日付の違いを日数で返す *)
let diff_by_days d1 d2 =
  let d1', _ = 
    mktime d1
  in
  let d2', _ = 
    mktime d2
  in
  int_of_float ((d1' -. d2') /. 86400.0)

(** 指定された年の国民の休日をリストで返す *)
let holidays year =
  let fix_holiday = [ (1, 1, "元日"); (2, 11, "建国記念日"); 
		      (4, 29, "みどりの日"); (5, 3, "憲法記念日"); 
		      (5, 4, "国民の休日"); (5, 5, "子供の日");
		      (11, 3, "文化の日"); (11, 23, "勤労感謝の日"); 
		      (12, 23, "天皇誕生日"); ]
  in
  let happy_monday = [ (1, 2, "成人の日"); (7, 3, "海の日"); 
		       (9, 3, "敬老の日"); (10, 2, "体育の日") ] 
  in
  let add_alternative g gl =
    (* 祝日が日曜日なら、振替休日 *)
    if g.tm_wday = 0 (* Sun *) then
      next_day g :: gl
    else
      gl
  in
  let fh_to_g gl (m, d, _) =
    let nd = make year m d in
    nd :: (add_alternative nd gl)
  in
  let hm_to_g gl (m, n, _) = 
    (* 対象となる月の最初の月曜日を見付け、7 * (n - 1) を足し算すると第n月曜日 *)
    let rec first_monday day =
      if day.tm_wday = 1 (* Mon *) then day
      else first_monday (next_day day)
    in
    let fm = first_monday (make year m 1) in
    let g = add_days fm (7 * (n - 1)) in
    g :: (add_alternative g gl)
  in
  let gfx = List.fold_left fh_to_g [] fix_holiday in
  let ghm = List.fold_left hm_to_g [] happy_monday in
  gfx @ ghm