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
;;
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
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
None, None -> None
| Some f, None
| None, Some 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
None, None -> None
| Some f, None
| None, Some 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 =
let (group_filter, item_filter) = split_filter f in
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 ""
;;