(** *)


open Tdl_types;;
open Tdl_date;;

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

(*c==v=[String.replace_in_string]=1.0====*)
let replace_in_string ~pat ~subs ~s =
  let len_pat = String.length pat in
  let len = String.length s in
  let b = Buffer.create len in
  let rec iter pos =
    if pos >= len then
      ()
    else
      if pos + len_pat > len then
        Buffer.add_string b (String.sub s pos (len - pos))
      else
        if String.sub s pos len_pat = pat then
          (
           Buffer.add_string b subs;
           iter (pos+len_pat)
          )
        else
          (
           Buffer.add_char b s.[pos];
           iter (pos+1);
          )
  in
  iter 0;
  Buffer.contents b
(*/c==v=[String.replace_in_string]=1.0====*)

let escape_quotes s =
  replace_in_string ~pat: "\"" ~subs: "\\\"" ~s;;

let string_of_date d =
  Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
    d.year d.month d.day d.hour d.minute d.second
;;

let string_of_filter f =
  let b = Buffer.create 256 in
  let rec iter = function
    Group s -> Printf.bprintf b "group: \"%s\"" (escape_quotes s)
  | Item s -> Printf.bprintf b "item: \"%s\"" (escape_quotes s)
  | Empty -> Buffer.add_string b "empty"
  | State s ->
      Printf.bprintf b "state: %s"
        (match s with
          Done -> "done"
         | Suspended -> "suspended"
         | Priority_low -> "low"
         | Priority_normal -> "normal"
         | Priority_high -> "high"
        )
  | Desc s -> Printf.bprintf b "desc: \"%s\""(escape_quotes s)
  | Before d ->
      Printf.bprintf b "before %s" (string_of_date d)
  | Or (f1, f2) ->
      iter f1 ;
      Buffer.add_string b " or ";
      iter f2
  | And (f1, f2) ->
      iter f1 ;
      Buffer.add_string b " and ";
      iter f2
  | Not f ->
      Buffer.add_string b "not ";
      iter f
  in
  iter f;
  Buffer.contents b
;;

let concat_paths p1 p2 =
  let p1 = if p1 = "/" then "" else p1 in
  p1^"/"^p2
;;

let title_verifies_path path cur_path t =
  let re = Str.regexp path in
  let complete = concat_paths cur_path t in
  Str.string_match re complete 0
;;

let rec group_verifies_filter f path g =
  match f with
    Group s -> Some (title_verifies_path s path g.group_title)
  | Empty -> Some (g.group_groups = [] && g.group_items = [])
  | And (f1, f2) ->
      begin
        match group_verifies_filter f1 path g,
          group_verifies_filter f2 path g
        with
          _, Some false
        | Some false, _ -> Some false
        | None, _
        | _, None -> None
        | _ -> Some true
      end
  | Or (f1, f2) ->
      begin
        match group_verifies_filter f1 path g,
          group_verifies_filter f2 path g
        with
          _, Some true
        | Some true, _ -> Some true
        | None, _
        | _, None -> None
        | _ -> Some false
      end
  | Not f ->
      begin
        match group_verifies_filter f path g with
          None -> None
        | Some b -> Some (not b)
      end
  | _ -> assert false
;;

let compare_dates d1 d2 =
  let d1 = (d1.year, d1.month, d1.day, d1.hour, d1.minute, d1.second)
  and d2 = (d2.year, d2.month, d2.day, d2.hour, d2.minute, d2.second) in
  Pervasives.compare d1 d2
;;

let rec item_verifies_filter f path i =
  match f with
    Item s -> title_verifies_path s path i.item_title
  | State s -> i.item_state = s
  | Desc s ->
      Str.string_match
        (Str.regexp s)
        (match i.item_desc with None -> "" | Some s -> s)
        0
  | Before d ->
      let d2 =
        match i.item_enddate with
          None -> i.item_date
        | Some d -> d
      in
      compare_dates d d2 >= 0
  | And (f1, f2) ->
      item_verifies_filter f1 path i && item_verifies_filter f2 path i
  | Or (f1, f2) ->
      item_verifies_filter f1 path i || item_verifies_filter f2 path i
  | Not f ->
      not (item_verifies_filter f path i)
  | _ -> assert false
;;

let filter_groups f path l =
  let pred g =
    match group_verifies_filter f path g with
      None -> true
    | Some b -> b
  in
  List.filter pred l
;;

let rec filter_filter kind = function
  Group s when kind = `Group -> Some (Group s)
| Group _ -> None
| Item s when kind = `Item -> Some (Item s)
| Item _ -> None
| Empty when kind = `Group -> Some Empty
| Empty -> None
| State s when kind = `Item -> Some (State s)
| State _ -> None
| Desc s when kind = `Item -> Some (Desc s)
| Desc _ -> None
| Before d when kind = `Item -> Some (Before d)
| Before _ -> None
| And (f1, f2) ->
    begin
      match filter_filter kind f1, filter_filter kind f2 with
        NoneNone -> None
      | Some f, None
      | NoneSome f -> Some f
      | Some f1, Some f2 -> Some (And (f1, f2))
    end
| Or (f1, f2) ->
    begin
      match filter_filter kind f1, filter_filter kind f2 with
        NoneNone -> None
      | Some f, None
      | NoneSome f -> Some f
      | Some f1, Some f2 -> Some (Or (f1, f2))
    end
| Not f ->
    match filter_filter kind f with
      None -> None
    | Some f -> Some (Not f)
;;

let split_filter f = (filter_filter `Group f, filter_filter `Item f);;

let filter_group f =
(*  prerr_endline (string_of_filter f);*)
  let (group_filter, item_filter) = split_filter f in
  (*
  prerr_endline
    (Printf.sprintf "group_filter: %s\nitem_filter: %s"
     (match group_filter with None -> "NONE" | Some f -> string_of_filter f)
       (match item_filter with None -> "NONE" | Some f -> string_of_filter f)
    );
    *)

  let rec iter path g =
    let new_path = concat_paths path g.group_title in
    let groups = List.map (iter new_path) g.group_groups in
    let groups = match group_filter with
        None -> groups
      | Some f -> filter_groups f new_path groups
    in
    let items = match item_filter with
        None -> g.group_items
      | Some f -> List.filter (item_verifies_filter f new_path) g.group_items
    in
    { g with group_groups = groups ; group_items = items ; }
  in
  iter ""
;;