(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Library General Public License as            *)
(*    published by the Free Software Foundation; either version 2 of the         *)
(*    License, or  any later version.                                            *)
(*                                                                               *)
(*    This program 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 Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library General Public          *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)


(* $Id: tdl.ml,v 1.5 2004/04/13 07:23:53 zoggy Exp $ *)

type date = Tdl_date.t = {
  year : int;                
                    (** complete year *)

  month : int;                
                    (** 1..12 *)

  day : int;                
                    (** 1..31 *)

  hour : int;
  minute : int;
  second : int;
  zone : int;                
                    (** in minutes; 60 = UTC+0100 *)

  week_day : int        
            (** 0 = sunday; -1 if not given *)

}

let since_epoch = Tdl_date.since_epoch
let float_to_date t = Tdl_date.create t

type state = Tdl_types.state =
    Done
  | Suspended
  | Priority_low
  | Priority_normal
  | Priority_high

let states =
  [
    Done ;
    Suspended ;
    Priority_low ;
    Priority_normal ;
    Priority_high ;
  ]

let string_of_state = Tdl_io.string_of_state

type item = Tdl_types.item =
    {
      mutable item_title : string;
      mutable item_date : Tdl_date.t ;
      mutable item_enddate : Tdl_date.t option;
      mutable item_desc : string option ;
      mutable item_state : state ;
      mutable item_id : int option;
   }

type group = Tdl_types.group =
    {
      mutable group_title : string;
      mutable group_items : item list;
      mutable group_groups : group list;
      mutable group_id : int option;
    }

let item ?id ~title ~state ?date ?enddate ?desc () =
  let i = Tdl_types.item () in
  i.item_title <- title;
  i.item_state <- state;
  (match date with None -> () | Some d -> i.item_date <- d);
  i.item_enddate <- enddate;
  i.item_desc <- desc;
  i.item_id <- id;
  i

let group ?id ?(title="") ?(items=[]) ?(groups=[]) () =
  let g = Tdl_types.group () in
  g.group_title <- title;
  g.group_items <- items;
  g.group_groups <- groups;
  g.group_id <- id;
  g

let group_of_file = Tdl_io.group_of_file
let group_of_string = Tdl_io.group_of_string
let group_of_channel = Tdl_io.group_of_channel

let remove_item g i =
  let rec iter = function
      [] -> []
    | i2 :: q ->
        if i = i2 then
          q
        else
          i2 :: iter q
  in
  g.group_items <- iter g.group_items

let remove_group ~father ~son =
  let rec iter = function
      [] -> []
    | son2 :: q ->
        if son = son2 then
          q
        else
          son2 :: iter q
  in
  father.group_groups <- iter father.group_groups

let print_group = Tdl_io.print_group

let print_file ?encoding file ch =
  let oc = open_out file in
  let fmt = Format.formatter_of_out_channel oc in
  print_group ?encoding fmt ch;
  Format.pp_print_flush fmt ();
  close_out oc

let copy_item i =
  item ?id: i.item_id
    ~title: i.item_title
    ~state: i.item_state
    ~date: i.item_date
    ?enddate: i.item_enddate
    ?desc: i.item_desc
    ()

let rec copy_group g =
  let items = List.map copy_item g.group_items in
  let groups = List.map copy_group g.group_groups in
  group ?id: g.group_id
    ~title: g.group_title
    ~items ~groups
    ()

let compare_item_state i1 i2 =
  match i1.item_state, i2.item_state with
   DoneDone ->
     Pervasives.compare i2.item_enddate i1.item_enddate
  | x, y when x = y ->
     Pervasives.compare i1.item_date i2.item_date
  | Done, _ -> 1
  | _, Done -> -1
  | Suspended, _ -> 1
  | _, Suspended -> -1
  | Priority_low, _ -> 1
  | _, Priority_low -> -1
  | Priority_normal, _ -> 1
  | _, Priority_normal -> -1
  | Priority_high, _ -> 1
(*  | _, Priority_high -> -1*)


let sort_items_by_state =
  List.sort compare_item_state;;

let merge_items l1 l2 =
  let new_items = List.filter
    (fun i2 -> try ignore(List.find ((=) i2) l1); false with Not_found -> true)
      l2
  in
  l1 @ new_items
;;

let rec insert_group ?(path=[]) g1 g2 =
  match path with
    [] ->
      begin
        try
          let g = List.find (fun g -> g.group_title = g2.group_title) g1.group_groups in
          let items = merge_items g.group_items g2.group_items in
          g.group_items <- items;
          List.iter (insert_group g) g2.group_groups
        with
          Not_found -> g1.group_groups <- g1.group_groups @ [g2]
      end
  | title :: q ->
      begin
        try
          let g = List.find (fun g -> g.group_title = title) g1.group_groups in
          insert_group ~path: q g g2
        with
          Not_found ->
            let empty = group ~title () in
            g1.group_groups <- g1.group_groups @ [empty];
            insert_group ~path: q empty g2
      end
;;

let merge_top_groups t1 t2 =
  let t1 = copy_group t1 in
  let t2 = copy_group t2 in
  List.iter (insert_group t1) t2.group_groups;
  t1.group_items <- merge_items t1.group_items t2.group_items;
  t1
;;

type filter = Tdl_filter.filter =
  Group of string
  | Item of string
  | Empty
  | State of Tdl_types.state
  | Desc of string
  | Before of date
  | Or of filter * filter
  | And of filter * filter
  | Not of filter
;;

let filter_of_lexbuf lb =
  try Tdl_filter_parser.filter Tdl_filter_lexer.main lb
  with e -> failwith (Printexc.to_string e)
;;

let filter_of_string s = filter_of_lexbuf (Lexing.from_string s);;
let filter_of_channel c = filter_of_lexbuf (Lexing.from_channel c);;

let filter_group = Tdl_filter.filter_group

module OrderedDay =
  struct
    type t = int * int * int
    let compare = Pervasives.compare
  end;;
module DaySet = Set.Make(OrderedDay);;

let day_of_tdl_date d = (d.year, d.month, d.day);;

let different_enddates_of_tdl tdl =
  let module DS = DaySet in
  let rec iter set g =
    let set = List.fold_left iter set g.group_groups in
    List.fold_right
      (fun i set ->
         match i.item_enddate with
           None -> set
         | Some d -> DS.add (day_of_tdl_date d) set
      )
      g.group_items
      set
  in
  let set = iter DS.empty tdl in
  List.sort OrderedDay.compare (DS.elements set)
;;

let filter_by_day (y,m,d) tdl =
  let pred i =
    match i.item_enddate with
      None -> false
    | Some date ->
        date.year = y && date.month = m && date.day = d
  in
  let pred_group g =
    g.group_groups <> [] or g.group_items <> []
  in
  let rec iter g =
    List.iter iter g.group_groups;
    g.group_items <- List.filter pred g.group_items;
    g.group_groups <- List.filter pred_group g.group_groups;
  in
  iter tdl;
  tdl
;;

let split_by_day f tdl =
  let dates = different_enddates_of_tdl tdl in
  let rec iter acc = function
    [] -> acc
  | day :: q ->
      let t = filter_by_day day (copy_group tdl) in
      iter ((day, t) :: acc) q
  in
  let l = iter [] dates in
  List.iter f l
;;