commit d97295ec46699fbe91fd4c15f9eef10b80c136f1 · ryan.freumh.org/caledonia

-1

TODO.org

···

       5
       5
        
       - [ ] really stress test the timezone handling -- this is full of gotcha's

     

       6
       6
        
       - [ ] don't load all calendars into memory to show only one event

     

       7
       7
        
       - [ ] support specifying duration

     

       8
       8
       -
       - [ ] make query filter a lambda

     

       9
       8
        
       - [ ] diagnose events failing to parse

     

       10
       9
        
       - [ ] [[https://github.com/robur-coop/icalendar/pull/13][handle RECURRENCE-ID]]

     

       11
       10
        
       - [ ] CalDAV syncing

+9 -8

lib/date.ml

···

       342
       342
        
             in

     

       343
       343
        
             timedesc_to_ptime dt

     

       344
       344
        
         | `Date date -> (

     

       345
       345
       -
           let y, m, d = date in

     

       346
       346
       -
           match Timedesc.Date.Ymd.make ~year:y ~month:m ~day:d with

     

       347
       347
       -
           | Ok new_date ->

     

       348
       348
       -
             let midnight = Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 () in

     

       349
       349
       -
               let new_dt = Timedesc.of_date_and_time_exn new_date midnight in

     

       350
       350
       -
               timedesc_to_ptime new_dt

     

       351
       351
       -
           | Error _ -> 

     

       352
       352
       -
                 failwith (Printf.sprintf "Invalid date %d-%d-%d" y m d))

     

       345
       345
       +
             let y, m, d = date in

     

       346
       346
       +
             match Timedesc.Date.Ymd.make ~year:y ~month:m ~day:d with

     

       347
       347
       +
             | Ok new_date ->

     

       348
       348
       +
                 let midnight =

     

       349
       349
       +
                   Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 ()

     

       350
       350
       +
                 in

     

       351
       351
       +
                 let new_dt = Timedesc.of_date_and_time_exn new_date midnight in

     

       352
       352
       +
                 timedesc_to_ptime new_dt

     

       353
       353
       +
             | Error _ -> failwith (Printf.sprintf "Invalid date %d-%d-%d" y m d))

+34

lib/event.ml

···

       193
       193
        
           fs / calendar_dir_path

     

       194
       194
        
           / (match t.collection with Col s -> s)

     

       195
       195
        
           / t.file_name)

     

       196
       196
       +
       

     

       197
       197
       +
       type comparator = t -> t -> int

     

       198
       198
       +
       

     

       199
       199
       +
       let by_start e1 e2 =

     

       200
       200
       +
         let t1 = get_start e1 in

     

       201
       201
       +
         let t2 = get_start e2 in

     

       202
       202
       +
         Ptime.compare t1 t2

     

       203
       203
       +
       

     

       204
       204
       +
       let by_end e1 e2 =

     

       205
       205
       +
         match (get_end e1, get_end e2) with

     

       206
       206
       +
         | Some t1, Some t2 -> Ptime.compare t1 t2

     

       207
       207
       +
         | Some _, None -> 1

     

       208
       208
       +
         | None, Some _ -> -1

     

       209
       209
       +
         | None, None -> 0

     

       210
       210
       +
       

     

       211
       211
       +
       let by_summary e1 e2 =

     

       212
       212
       +
         match (get_summary e1, get_summary e2) with

     

       213
       213
       +
         | Some s1, Some s2 -> String.compare s1 s2

     

       214
       214
       +
         | Some _, None -> 1

     

       215
       215
       +
         | None, Some _ -> -1

     

       216
       216
       +
         | None, None -> 0

     

       217
       217
       +
       

     

       218
       218
       +
       let by_location e1 e2 =

     

       219
       219
       +
         match (get_location e1, get_location e2) with

     

       220
       220
       +
         | Some l1, Some l2 -> String.compare l1 l2

     

       221
       221
       +
         | Some _, None -> 1

     

       222
       222
       +
         | None, Some _ -> -1

     

       223
       223
       +
         | None, None -> 0

     

       224
       224
       +
       

     

       225
       225
       +
       let by_collection e1 e2 =

     

       226
       226
       +
         match (get_collection e1, get_collection e2) with

     

       227
       227
       +
         | Collection.Col c1, Collection.Col c2 -> String.compare c1 c2

     

       228
       228
       +
       

     

       229
       229
       +
       let descending comp e1 e2 = -1 * comp e1 e2

+24

lib/event.mli

···

       73
       73
        
       

     

       74
       74
        
       val get_file_path :

     

       75
       75
        
         fs:'a Eio.Path.t -> calendar_dir_path:string -> t -> 'a Eio.Path.t

     

       76
       76
       +
       

     

       77
       77
       +
       type comparator = t -> t -> int

     

       78
       78
       +
       (** Event comparator function type *)

     

       79
       79
       +
       

     

       80
       80
       +
       val by_start : comparator

     

       81
       81
       +
       (** Compare events by start time, earlier times come first *)

     

       82
       82
       +
       

     

       83
       83
       +
       val by_end : comparator

     

       84
       84
       +
       (** Compare events by end time, earlier times come first. Events with end times

     

       85
       85
       +
           come after those without *)

     

       86
       86
       +
       

     

       87
       87
       +
       val by_summary : comparator

     

       88
       88
       +
       (** Compare events by summary alphabetically. Events with summaries come before

     

       89
       89
       +
           those without *)

     

       90
       90
       +
       

     

       91
       91
       +
       val by_location : comparator

     

       92
       92
       +
       (** Compare events by location alphabetically. Events with locations come before

     

       93
       93
       +
           those without *)

     

       94
       94
       +
       

     

       95
       95
       +
       val by_collection : comparator

     

       96
       96
       +
       (** Compare events by collection name alphabetically *)

     

       97
       97
       +
       

     

       98
       98
       +
       val descending : comparator -> comparator

     

       99
       99
       +
       (** Reverse the order of a comparator *)

+36 -120

lib/query.ml

···

       1
       1
       -
       type filter =

     

       2
       2
       -
         | SummaryContains of string

     

       3
       3
       -
         | DescriptionContains of string

     

       4
       4
       -
         | LocationContains of string

     

       5
       5
       -
         | InCollections of Collection.t list

     

       6
       6
       -
         | RecurringOnly

     

       7
       7
       -
         | NonRecurringOnly

     

       8
       8
       -
         | WithId of Event.event_id

     

       9
       9
       -
         | And of filter list

     

       10
       10
       -
         | Or of filter list

     

       11
       11
       -
         | Not of filter

     

       1
       1
       +
       type filter = Event.t -> bool

     

       12
       2
        
       

     

       13
       13
       -
       type sort_order = [ `Ascending | `Descending ]

     

       14
       14
       -
       type sort_by = [ `Start | `End | `Summary | `Location | `Calendar ]

     

       3
       3
       +
       let text_matches pattern text =

     

       4
       4
       +
         let re = Re.Pcre.regexp ~flags:[ `CASELESS ] (Re.Pcre.quote pattern) in

     

       5
       5
       +
         Re.Pcre.pmatch ~rex:re text

     

       15
       6
        
       

     

       16
       16
       -
       let summary_contains text = SummaryContains text

     

       17
       17
       -
       let description_contains text = DescriptionContains text

     

       18
       18
       -
       let location_contains text = LocationContains text

     

       19
       19
       -
       let in_collections ids = InCollections ids

     

       20
       20
       -
       let recurring_only () = RecurringOnly

     

       21
       21
       -
       let non_recurring_only () = NonRecurringOnly

     

       22
       22
       -
       let with_id id = WithId id

     

       23
       23
       -
       let and_filter filters = And filters

     

       24
       24
       -
       let or_filter filters = Or filters

     

       25
       25
       -
       let not_filter filter = Not filter

     

       7
       7
       +
       let summary_contains text event =

     

       8
       8
       +
         match Event.get_summary event with

     

       9
       9
       +
         | Some summary -> text_matches text summary

     

       10
       10
       +
         | None -> false

     

       26
       11
        
       

     

       27
       27
       -
       let rec matches_filter event = function

     

       28
       28
       -
         | SummaryContains text -> (

     

       29
       29
       -
             match Event.get_summary event with

     

       30
       30
       -
             | Some summary ->

     

       31
       31
       -
                 let re = Re.Pcre.regexp ~flags:[ `CASELESS ] (Re.Pcre.quote text) in

     

       32
       32
       -
                 Re.Pcre.pmatch ~rex:re summary

     

       33
       33
       -
             | None -> false)

     

       34
       34
       -
         | DescriptionContains text -> (

     

       35
       35
       -
             match Event.get_description event with

     

       36
       36
       -
             | Some desc ->

     

       37
       37
       -
                 let re = Re.Pcre.regexp ~flags:[ `CASELESS ] (Re.Pcre.quote text) in

     

       38
       38
       -
                 Re.Pcre.pmatch ~rex:re desc

     

       39
       39
       -
             | None -> false)

     

       40
       40
       -
         | LocationContains text -> (

     

       41
       41
       -
             match Event.get_location event with

     

       42
       42
       -
             | Some loc ->

     

       43
       43
       -
                 let re = Re.Pcre.regexp ~flags:[ `CASELESS ] (Re.Pcre.quote text) in

     

       44
       44
       -
                 Re.Pcre.pmatch ~rex:re loc

     

       45
       45
       -
             | None -> false)

     

       46
       46
       -
         | InCollections ids ->

     

       47
       47
       -
             let id = Event.get_collection event in

     

       48
       48
       -
             List.exists (fun col -> col = id) ids

     

       49
       49
       -
         | RecurringOnly -> Event.get_recurrence event <> None

     

       50
       50
       -
         | NonRecurringOnly -> Event.get_recurrence event = None

     

       51
       51
       -
         | WithId id -> Event.get_id event = id

     

       52
       52
       -
         | And filters -> List.for_all (matches_filter event) filters

     

       53
       53
       -
         | Or filters -> List.exists (matches_filter event) filters

     

       54
       54
       -
         | Not filter -> not (matches_filter event filter)

     

       12
       12
       +
       let description_contains text event =

     

       13
       13
       +
         match Event.get_description event with

     

       14
       14
       +
         | Some desc -> text_matches text desc

     

       15
       15
       +
         | None -> false

     

       55
       16
        
       

     

       56
       56
       -
       let compare_events sort_by order e1 e2 =

     

       57
       57
       -
         let compare =

     

       58
       58
       -
           match sort_by with

     

       59
       59
       -
           | `Start ->

     

       60
       60
       -
               let t1 = Event.get_start e1 in

     

       61
       61
       -
               let t2 = Event.get_start e2 in

     

       62
       62
       -
               Ptime.compare t1 t2

     

       63
       63
       -
           | `End -> (

     

       64
       64
       -
               match (Event.get_end e1, Event.get_end e2) with

     

       65
       65
       -
               | Some t1, Some t2 -> Ptime.compare t1 t2

     

       66
       66
       -
               | Some _, None -> 1

     

       67
       67
       -
               | None, Some _ -> -1

     

       68
       68
       -
               | None, None -> 0)

     

       69
       69
       -
           | `Summary -> (

     

       70
       70
       -
               match (Event.get_location e1, Event.get_location e2) with

     

       71
       71
       -
               | Some l1, Some l2 -> String.compare l1 l2

     

       72
       72
       -
               | Some _, None -> 1

     

       73
       73
       -
               | None, Some _ -> -1

     

       74
       74
       -
               | None, None -> 0)

     

       75
       75
       -
           | `Location -> (

     

       76
       76
       -
               match (Event.get_location e1, Event.get_location e2) with

     

       77
       77
       -
               | Some l1, Some l2 -> String.compare l1 l2

     

       78
       78
       -
               | Some _, None -> 1

     

       79
       79
       -
               | None, Some _ -> -1

     

       80
       80
       -
               | None, None -> 0)

     

       81
       81
       -
           | `Calendar -> (

     

       82
       82
       -
               match (Event.get_collection e1, Event.get_collection e2) with

     

       83
       83
       -
               | Collection.Col c1, Collection.Col c2 -> String.compare c1 c2)

     

       84
       84
       -
         in

     

       85
       85
       -
         match order with `Ascending -> compare | `Descending -> -compare

     

       17
       17
       +
       let location_contains text event =

     

       18
       18
       +
         match Event.get_location event with

     

       19
       19
       +
         | Some loc -> text_matches text loc

     

       20
       20
       +
         | None -> false

     

       21
       21
       +
       

     

       22
       22
       +
       let in_collections ids event =

     

       23
       23
       +
         let id = Event.get_collection event in

     

       24
       24
       +
         List.exists (fun col -> col = id) ids

     

       25
       25
       +
       

     

       26
       26
       +
       let recurring_only () event = Event.get_recurrence event <> None

     

       27
       27
       +
       let non_recurring_only () event = Event.get_recurrence event = None

     

       28
       28
       +
       let with_id id event = Event.get_id event = id

     

       29
       29
       +
       let and_filter filters event = List.for_all (fun filter -> filter event) filters

     

       30
       30
       +
       let or_filter filters event = List.exists (fun filter -> filter event) filters

     

       31
       31
       +
       let not_filter filter event = not (filter event)

     

       32
       32
       +
       let matches_filter event filter = filter event

     

       86
       33
        
       

     

       87
       87
       -
       let query_events ~fs calendar_dir ?filter ?sort_by ?order ?limit () =

     

       34
       34
       +
       let query_events ~fs calendar_dir ?filter ?(comparator = Event.by_start) ?limit

     

       35
       35
       +
           () =

     

       88
       36
        
         let ( let* ) = Result.bind in

     

       89
       37
        
         let* collections = Calendar_dir.get_collections ~fs calendar_dir in

     

       90
       38
        
         let events =

     

       91
       39
        
           List.flatten (List.map (fun (_collection, events) -> events) collections)

     

       92
       40
        
         in

     

       93
       41
        
         let filtered_events =

     

       94
       94
       -
           match filter with

     

       95
       95
       -
           | Some f -> List.filter (fun event -> matches_filter event f) events

     

       96
       96
       -
           | None -> events

     

       97
       97
       -
         in

     

       98
       98
       -
         let sorted_events =

     

       99
       99
       -
           match (sort_by, order) with

     

       100
       100
       -
           | Some criteria, Some ord ->

     

       101
       101
       -
               List.sort (compare_events criteria ord) filtered_events

     

       102
       102
       -
           | Some criteria, None ->

     

       103
       103
       -
               List.sort (compare_events criteria `Ascending) filtered_events

     

       104
       104
       -
           | None, _ -> List.sort (compare_events `Start `Ascending) filtered_events

     

       42
       42
       +
           match filter with Some f -> List.filter f events | None -> events

     

       105
       43
        
         in

     

       44
       44
       +
         let sorted_events = List.sort comparator filtered_events in

     

       106
       45
        
         Ok

     

       107
       46
        
           (match limit with

     

       108
       47
        
           | Some n when n > 0 ->

     
···

       115
       54
        
               take n sorted_events []

     

       116
       55
        
           | _ -> sorted_events)

     

       117
       56
        
       

     

       118
       118
       -
       let query ~fs calendar_dir ?filter ~from ~to_ ?sort_by ?order ?limit () =

     

       57
       57
       +
       let query ~fs calendar_dir ?filter ~from ~to_

     

       58
       58
       +
           ?(comparator = Recur.Instance.by_start) ?limit () =

     

       119
       59
        
         Fmt.epr "Querying from %a to %a\n%!" Ptime.pp (Option.get from) Ptime.pp to_;

     

       120
       120
       -
         match query_events ~fs calendar_dir ?filter ?sort_by ?order () with

     

       60
       60
       +
         match query_events ~fs calendar_dir ?filter () with

     

       121
       61
        
         | Ok events ->

     

       122
       62
        
             let instances =

     

       123
       63
        
               List.concat_map

     

       124
       64
        
                 (fun event -> Recur.expand_event event ~from ~to_)

     

       125
       65
        
                 events

     

       126
       66
        
             in

     

       127
       127
       -
             let compare_instances criteria ord i1 i2 =

     

       128
       128
       -
               match criteria with

     

       129
       129
       -
               | `Start ->

     

       130
       130
       -
                   let c = Ptime.compare i1.Recur.start i2.Recur.start in

     

       131
       131
       -
                   if ord = `Ascending then c else -c

     

       132
       132
       -
               | `End -> (

     

       133
       133
       -
                   match (i1.Recur.end_, i2.Recur.end_) with

     

       134
       134
       -
                   | Some t1, Some t2 ->

     

       135
       135
       -
                       let c = Ptime.compare t1 t2 in

     

       136
       136
       -
                       if ord = `Ascending then c else -c

     

       137
       137
       -
                   | Some _, None -> if ord = `Ascending then 1 else -1

     

       138
       138
       -
                   | None, Some _ -> if ord = `Ascending then -1 else 1

     

       139
       139
       -
                   | None, None -> 0)

     

       140
       140
       -
               | other ->

     

       141
       141
       -
                   let c = compare_events other ord i1.Recur.event i2.Recur.event in

     

       142
       142
       -
                   if ord = `Ascending then c else -c

     

       143
       143
       -
             in

     

       144
       144
       -
             let sorted_instances =

     

       145
       145
       -
               match (sort_by, order) with

     

       146
       146
       -
               | Some criteria, Some ord ->

     

       147
       147
       -
                   List.sort (compare_instances criteria ord) instances

     

       148
       148
       -
               | Some criteria, None ->

     

       149
       149
       -
                   List.sort (compare_instances criteria `Ascending) instances

     

       150
       150
       -
               | None, _ -> List.sort (compare_instances `Start `Ascending) instances

     

       151
       151
       -
             in

     

       67
       67
       +
             let sorted_instances = List.sort comparator instances in

     

       152
       68
        
             Ok

     

       153
       69
        
               (match limit with

     

       154
       70
        
               | Some n when n > 0 ->

+3 -15

lib/query.mli

···

       1
       1
        
       (** Filter-based searching and querying of calendar events *)

     

       2
       2
        
       

     

       3
       3
       -
       type filter

     

       4
       4
       -
       (** Type representing a query filter *)

     

       5
       5
       -
       

     

       6
       6
       -
       type sort_order = [ `Ascending | `Descending ]

     

       7
       7
       -
       (** Type representing the sort order *)

     

       8
       8
       -
       

     

       9
       9
       -
       type sort_by = [ `Start | `End | `Summary | `Location | `Calendar ]

     

       10
       10
       -
       (** Type representing sort criteria *)

     

       3
       3
       +
       type filter = Event.t -> bool

     

       11
       4
        
       

     

       12
       5
        
       val summary_contains : string -> filter

     

       13
       6
        
       val description_contains : string -> filter

     
···

       24
       17
        
         fs:[> Eio.Fs.dir_ty ] Eio.Path.t ->

     

       25
       18
        
         Calendar_dir.t ->

     

       26
       19
        
         ?filter:filter ->

     

       27
       27
       -
         ?sort_by:[< `Calendar | `End | `Location | `Start | `Summary ] ->

     

       28
       28
       -
         ?order:[< `Ascending | `Descending ] ->

     

       20
       20
       +
         ?comparator:Event.comparator ->

     

       29
       21
        
         ?limit:int ->

     

       30
       22
        
         unit ->

     

       31
       23
        
         (Event.t list, [> `Msg of string ]) result

     
···

       38
       30
        
         ?filter:filter ->

     

       39
       31
        
         from:Ptime.t option ->

     

       40
       32
        
         to_:Ptime.t ->

     

       41
       41
       -
         ?sort_by:sort_by ->

     

       42
       42
       -
         ?order:sort_order ->

     

       33
       33
       +
         ?comparator:Recur.Instance.comparator ->

     

       43
       34
        
         ?limit:int ->

     

       44
       35
        
         unit ->

     

       45
       36
        
         (Recur.instance list, [> `Msg of string ]) result

     
···

       49
       40
        
       (* Test-only helper functions *)

     

       50
       41
        
       val matches_filter : Event.t -> filter -> bool

     

       51
       42
        
       (** Check if an event matches the given filter *)

     

       52
       52
       -
       

     

       53
       53
       -
       val compare_events : sort_by -> sort_order -> Event.t -> Event.t -> int

     

       54
       54
       -
       (** Compare two events based on the sort criteria and order *)

+17

lib/recur.ml

···

       2
       2
        
       

     

       3
       3
        
       type instance = { event : Event.t; start : Ptime.t; end_ : Ptime.t option }

     

       4
       4
        
       

     

       5
       5
       +
       module Instance = struct

     

       6
       6
       +
         type t = instance

     

       7
       7
       +
         type comparator = t -> t -> int

     

       8
       8
       +
       

     

       9
       9
       +
         let by_start i1 i2 = Ptime.compare i1.start i2.start

     

       10
       10
       +
       

     

       11
       11
       +
         let by_end i1 i2 =

     

       12
       12
       +
           match (i1.end_, i2.end_) with

     

       13
       13
       +
           | Some t1, Some t2 -> Ptime.compare t1 t2

     

       14
       14
       +
           | Some _, None -> 1

     

       15
       15
       +
           | None, Some _ -> -1

     

       16
       16
       +
           | None, None -> 0

     

       17
       17
       +
       

     

       18
       18
       +
         let by_event event_comp i1 i2 = event_comp i1.event i2.event

     

       19
       19
       +
         let descending comp i1 i2 = -1 * comp i1 i2

     

       20
       20
       +
       end

     

       21
       21
       +
       

     

       5
       22
        
       let clone_with_time original start =

     

       6
       23
        
         let duration = Event.get_duration original in

     

       7
       24
        
         let end_ =

+20

lib/recur.mli

···

       1
       1
        
       type instance = { event : Event.t; start : Ptime.t; end_ : Ptime.t option }

     

       2
       2
        
       (** Instances of recurring events with adjusted start/end times *)

     

       3
       3
        
       

     

       4
       4
       +
       module Instance : sig

     

       5
       5
       +
         type t = instance

     

       6
       6
       +
       

     

       7
       7
       +
         type comparator = t -> t -> int

     

       8
       8
       +
         (** Instance comparator function type *)

     

       9
       9
       +
       

     

       10
       10
       +
         val by_start : comparator

     

       11
       11
       +
         (** Compare instances by start time, earlier times come first *)

     

       12
       12
       +
       

     

       13
       13
       +
         val by_end : comparator

     

       14
       14
       +
         (** Compare instances by end time, earlier times come first.

     

       15
       15
       +
             Instances with end times come after those without *)

     

       16
       16
       +
       

     

       17
       17
       +
         val by_event : Event.comparator -> comparator

     

       18
       18
       +
         (** Apply an event comparator to instances *)

     

       19
       19
       +
       

     

       20
       20
       +
         val descending : comparator -> comparator

     

       21
       21
       +
         (** Reverse the order of a comparator *)

     

       22
       22
       +
       end

     

       23
       23
       +
       

     

       4
       24
        
       val expand_event :

     

       5
       25
        
         Event.t -> from:Ptime.t option -> to_:Ptime.t -> instance list

     

       6
       26
        
       (** Generates all instances of an event within a date range, including the