open Format;;
open Tdl;;
let rss_item_of_tdl_item i =
match i.item_enddate with
None -> None
| Some d ->
let pubdate =
{ Rss.year = d.year ;
Rss.month = d.month ;
Rss.day = d.day ;
Rss.hour = d.hour ;
Rss.minute = d.minute ;
Rss.second = d.second ;
Rss.zone = d.zone ;
Rss.week_day = d.week_day ;
}
in
Some
(Rss.item
~title: i.item_title
?desc: i.item_desc
~pubdate
()
)
let rss_items_of_tdl tdl =
let rec gather_items acc groups = function
[] -> acc
| i :: q ->
match rss_item_of_tdl_item i with
None -> gather_items acc groups q
| Some i -> gather_items ((groups, i) :: acc) groups q
in
let rec gather_groups groups acc = function
[] -> acc
| g :: q ->
let new_groups = groups @ [g.group_title] in
let new_acc = gather_items acc new_groups g.group_items in
let new_acc = gather_groups new_groups new_acc g.group_groups in
gather_groups groups new_acc q
in
(gather_items [] [] tdl.group_items) @
(gather_groups [] [] tdl.group_groups)
let rss_channel_of_tdl title tdl =
let rss_items = rss_items_of_tdl tdl in
let rss_items = List.sort
(fun (_,i1) (_,i2) ->
Pervasives.compare i2.Rss.item_pubdate i1.Rss.item_pubdate)
rss_items
in
let rss_items = List.map
(fun (groups,i) ->
match groups with
[] -> i
| _ ->
let item_title =
match i.Rss.item_title with
None -> ""
| Some s -> s
in
let item_title =
Printf.sprintf "[%s]%s" (String.concat "/" groups) item_title
in
{ i with Rss.item_title = Some item_title }
)
rss_items
in
Rss.channel
~title
~generator: Tdl_messages.software
~desc: "My things done"
~link: "http://pauillac.inria.fr/~guesdon/todo.rss"
rss_items
;;
let split_by_day prefix =
let f ((y,m,d), tdl) =
let file = Printf.sprintf "%s-%04d-%02d-%02d.tdl" prefix y m d in
Tdl.print_file file tdl
in
Tdl.split_by_day f
;;
type output_type = Rss | Tdl | Tdl_by_day of string;;
let output_type = ref Tdl;;
let filter = ref None;;
let remaining = ref [];;
let options = [
"-", Arg.Unit (fun () -> remaining := "-" :: !remaining),
"\t\tadd standard input as source of a todo list to read" ;
"--rss", Arg.Unit (fun () -> output_type := Rss), "\toutput RSS";
"--tdl", Arg.Unit (fun () -> output_type := Tdl), "\toutput a new todo list (default)\n\t\t(used to merge todo lists)";
"--filter", Arg.String (fun s -> filter := Some (Tdl.filter_of_string s)),
"s\tapply the given filter on read groups";
"--split-by-day", Arg.String (fun s -> output_type := Tdl_by_day s),
"<prefix>\n\t\tsplit todo list(s) to create one separate todo list by day,\n"^
"\t\tin files named prefix-<year>-<month>-<day>.tdl";
];;
let tdl_of_file f =
let g =
match f with
"-" -> Tdl.group_of_channel stdin
| _ -> Tdl.group_of_file f
in
match !filter with
None -> g
| Some f -> Tdl.filter_group f g
;;
let main () =
Arg.parse options
(fun s -> remaining := s :: !remaining)
(Printf.sprintf "Usage: %s [options] <files>\nThe '-' file is the standard input.\nOptions are:" Sys.argv.(0));
match List.rev !remaining with
[] ->
prerr_endline (Printf.sprintf "Usage: %s [options] <files>" Sys.argv.(0));
exit 1
| files ->
try
let tdl = List.fold_left
(fun acc f -> Tdl.merge_top_groups (tdl_of_file f) acc)
(Tdl.group ())
files
in
match !output_type with
Rss ->
let channel = rss_channel_of_tdl "Things done" tdl in
Rss.print_channel (formatter_of_out_channel stdout) channel
| Tdl ->
Tdl.print_group Format.std_formatter tdl;
Format.print_flush ()
| Tdl_by_day prefix ->
split_by_day prefix tdl
with
Sys_error s
| Failure s ->
prerr_endline s ; exit 1
;;
main ()