Command-line and Emacs Calendar Client
ryan.freumh.org
1type filter =
2 | SummaryContains of string
3 | DescriptionContains of string
4 | LocationContains of string
5 | InCollections of Collection.t list
6 | RecurringOnly
7 | NonRecurringOnly
8 | WithId of Event.event_id
9 | And of filter list
10 | Or of filter list
11 | Not of filter
12
13type sort_order = [ `Ascending | `Descending ]
14type sort_by = [ `Start | `End | `Summary | `Location | `Calendar ]
15
16let summary_contains text = SummaryContains text
17let description_contains text = DescriptionContains text
18let location_contains text = LocationContains text
19let in_collections ids = InCollections ids
20let recurring_only () = RecurringOnly
21let non_recurring_only () = NonRecurringOnly
22let with_id id = WithId id
23let and_filter filters = And filters
24let or_filter filters = Or filters
25let not_filter filter = Not filter
26
27let rec matches_filter event = function
28 | SummaryContains text -> (
29 match Event.get_summary event with
30 | Some summary ->
31 let re = Re.Pcre.regexp ~flags:[ `CASELESS ] (Re.Pcre.quote text) in
32 Re.Pcre.pmatch ~rex:re summary
33 | None -> false)
34 | DescriptionContains text -> (
35 match Event.get_description event with
36 | Some desc ->
37 let re = Re.Pcre.regexp ~flags:[ `CASELESS ] (Re.Pcre.quote text) in
38 Re.Pcre.pmatch ~rex:re desc
39 | None -> false)
40 | LocationContains text -> (
41 match Event.get_location event with
42 | Some loc ->
43 let re = Re.Pcre.regexp ~flags:[ `CASELESS ] (Re.Pcre.quote text) in
44 Re.Pcre.pmatch ~rex:re loc
45 | None -> false)
46 | InCollections ids ->
47 let id = Event.get_collection event in
48 List.exists (fun col -> col = id) ids
49 | RecurringOnly -> Event.get_recurrence event <> None
50 | NonRecurringOnly -> Event.get_recurrence event = None
51 | WithId id -> Event.get_id event = id
52 | And filters -> List.for_all (matches_filter event) filters
53 | Or filters -> List.exists (matches_filter event) filters
54 | Not filter -> not (matches_filter event filter)
55
56let compare_events sort_by order e1 e2 =
57 let compare =
58 match sort_by with
59 | `Start ->
60 let t1 = Event.get_start e1 in
61 let t2 = Event.get_start e2 in
62 Ptime.compare t1 t2
63 | `End -> (
64 match (Event.get_end e1, Event.get_end e2) with
65 | Some t1, Some t2 -> Ptime.compare t1 t2
66 | Some _, None -> 1
67 | None, Some _ -> -1
68 | None, None -> 0)
69 | `Summary -> (
70 match (Event.get_location e1, Event.get_location e2) with
71 | Some l1, Some l2 -> String.compare l1 l2
72 | Some _, None -> 1
73 | None, Some _ -> -1
74 | None, None -> 0)
75 | `Location -> (
76 match (Event.get_location e1, Event.get_location e2) with
77 | Some l1, Some l2 -> String.compare l1 l2
78 | Some _, None -> 1
79 | None, Some _ -> -1
80 | None, None -> 0)
81 | `Calendar -> (
82 match (Event.get_collection e1, Event.get_collection e2) with
83 | Collection.Col c1, Collection.Col c2 -> String.compare c1 c2)
84 in
85 match order with `Ascending -> compare | `Descending -> -compare
86
87let query_events ~fs calendar_dir ?filter ?sort_by ?order ?limit () =
88 let ( let* ) = Result.bind in
89 let* collections = Calendar_dir.get_collections ~fs calendar_dir in
90 let events =
91 List.flatten (List.map (fun (_collection, events) -> events) collections)
92 in
93 let filtered_events =
94 match filter with
95 | Some f -> List.filter (fun event -> matches_filter event f) events
96 | None -> events
97 in
98 let sorted_events =
99 match (sort_by, order) with
100 | Some criteria, Some ord ->
101 List.sort (compare_events criteria ord) filtered_events
102 | Some criteria, None ->
103 List.sort (compare_events criteria `Ascending) filtered_events
104 | None, _ -> List.sort (compare_events `Start `Ascending) filtered_events
105 in
106 Ok
107 (match limit with
108 | Some n when n > 0 ->
109 let rec take n lst acc =
110 match (lst, n) with
111 | _, 0 -> List.rev acc
112 | [], _ -> List.rev acc
113 | x :: xs, n -> take (n - 1) xs (x :: acc)
114 in
115 take n sorted_events []
116 | _ -> sorted_events)
117
118let query ~fs calendar_dir ?filter ~from ~to_ ?sort_by ?order ?limit () =
119 match query_events ~fs calendar_dir ?filter ?sort_by ?order () with
120 | Ok events ->
121 let instances =
122 List.concat_map
123 (fun event -> Recur.expand_event event ~from ~to_)
124 events
125 in
126 let compare_instances criteria ord i1 i2 =
127 match criteria with
128 | `Start ->
129 let c = Ptime.compare i1.Recur.start i2.Recur.start in
130 if ord = `Ascending then c else -c
131 | `End -> (
132 match (i1.Recur.end_, i2.Recur.end_) with
133 | Some t1, Some t2 ->
134 let c = Ptime.compare t1 t2 in
135 if ord = `Ascending then c else -c
136 | Some _, None -> if ord = `Ascending then 1 else -1
137 | None, Some _ -> if ord = `Ascending then -1 else 1
138 | None, None -> 0)
139 | other ->
140 let c = compare_events other ord i1.Recur.event i2.Recur.event in
141 if ord = `Ascending then c else -c
142 in
143 let sorted_instances =
144 match (sort_by, order) with
145 | Some criteria, Some ord ->
146 List.sort (compare_instances criteria ord) instances
147 | Some criteria, None ->
148 List.sort (compare_instances criteria `Ascending) instances
149 | None, _ -> List.sort (compare_instances `Start `Ascending) instances
150 in
151 Ok
152 (match limit with
153 | Some n when n > 0 ->
154 let rec take n lst acc =
155 match (lst, n) with
156 | _, 0 -> List.rev acc
157 | [], _ -> List.rev acc
158 | x :: xs, n -> take (n - 1) xs (x :: acc)
159 in
160 take n sorted_instances []
161 | _ -> sorted_instances)
162 | Error e -> Error e