type date = Tdl_date.t = {
year : int;
month : int;
day : int;
hour : int;
minute : int;
second : int;
zone : int;
week_day : int
}
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
Done, Done ->
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
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
;;