(* Copyright 2005-2008 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER.

This file is part of Dose2.

Dose2 is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Dose2 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>. *)
open CalendarLib;;
open Io;;
module G = Generic_io;;

exception Empty;;

type day = int;;
type lifetime = (day * day) list;;

let io_day = io_int;;
let io_lifetime = io_list (io_pair io_day io_day);;

let day_of_ymd (y,m,d) = Date.to_mjd (Date.make y m d);;

let ymd_of_day j =
  let d = Date.from_mjd j in
  (Date.year d, Date.int_of_month (Date.month d), Date.day_of_month d)
;;

let empty = [];;

let singleton j = [(j,j)];;

let load fn = G.load_from_file io_lifetime fn;;
let save fn lf = G.save_to_file io_lifetime lf fn;;

let print_day oc j =
  let (y,m,d) = ymd_of_day j in
  Printf.fprintf oc "%04d-%02d-%02d" y m d
;;

let output oc lf =
  let first = ref true in
  Printf.fprintf oc "[";
  List.iter
    begin fun (x,y) ->
      if !first then first := false else Printf.fprintf oc "; ";
      Printf.fprintf oc "(%a,%a)" print_day x print_day y
    end
    lf;
  Printf.fprintf oc "]"
;;

let inner_add_day lf j =
  let rec loop = function
    | [] -> [(j,j)]
    | [(j1,j2)] as stuff ->
        if j1 <= j && j <= j2 then
          stuff
        else
          if j < j1 then
            (j,j)::stuff
          else
            if j2 + 1 = j then
              [(j1,j2+1)]
            else
              [(j1,j2);(j,j)]
    | ((j1,j2)::(j3,j4)::rest) as stuff ->
          if j < j1 then
            (* Before the first interval *)
            if j = j1 - 1 then
              (* Just before, extend the first *)
              (j,j2) :: (j3,j4) :: rest
            else
              (* Do not extend the first *)
              (j,j)::stuff
          else
            if j <= j2 then
              (* Absorbed by first interval *)
              stuff
            else
              if j = j2 + 1 then
                (* Extends the first interval by one day to the future *)
                if j = j3 then
                  begin
                    (* The first two intervals merge *)
                    (j1,j4)::rest
                  end
                else
                  (* The first two intervals remain disjoint *)
                  (j1,j2+1)::(j3,j4)::rest
              else
                (j1,j2)::(loop ((j3,j4)::rest))
  in
  loop lf
;;

let add_day lf j =
  inner_add_day lf j
;;

let iterate_over_intervals f lf =
  List.iter f lf
;;

let iterate_over_days f lf =
  List.iter
    begin fun (j1,j2) ->
      for j = j1 to j2 do
        f j
      done
    end
    lf
;;

let is_empty = function
  | [] -> true
  | _ -> false
;;

let range = function
  | [] -> raise Empty
  | (j1, j2) :: rest ->
      List.fold_left
        begin fun (j1, j2) (j1', j2') ->
          (min j1 j1', max j2 j2')
        end
        (j1,j2)
        rest
;;

(*val add_interval : lifetime -> day * day -> lifetime (** [add_interval lf (a,b)] returns a lifetime with all the days in
[lf] and all the days in the set \{[a],[a+1],...,[b]\}.  If [b < a] then no day is added. *) *)
