commit 692888aee81d5fd3625bdddab6d88768cc94f4e1 · ryan.freumh.org/caledonia

TODO.org

···

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

     

       9
       9
        
       - [ ] support specifying duration

     

       10
       10
        
       - [ ] better add/edit event datetime parsing

     

       11
       11
       +
         - day of the week

     

       12
       12
       +
         - month names

     

       13
       13
       +
         - allow editting date or time without touching the other

     

       11
       14
        
       - [x] diagnose events failing to parse [[https://github.com/robur-coop/icalendar/issues/14]]

     

       12
       15
        
       - [x] [[https://github.com/robur-coop/icalendar/pull/13][handle RECURRENCE-ID]]

     

       13
       16
        
       - [x] [[https://github.com/robur-coop/icalendar/issues/15][RRULE with local datetime]]

+12 -3

bin/add_cmd.ml

···

       14
       14
        
         in

     

       15
       15
        
         let* end_ =

     

       16
       16
        
           let end_date =

     

       17
       17
       -
             match end_date with None -> start_date | Some e -> Some e

     

       17
       17
       +
             (* if we have an endtime and no end date default to start date *)

     

       18
       18
       +
             match (end_date, end_time) with

     

       19
       19
       +
             | None, Some _ -> start_date

     

       20
       20
       +
             | _ -> end_date

     

       21
       21
       +
           in

     

       22
       22
       +
           let end_timezone =

     

       23
       23
       +
             (* if we specify and end date and time without a end timezone, default to the start timezone *)

     

       24
       24
       +
             match (end_date, end_time, end_timezone) with

     

       25
       25
       +
             | Some _, Some _, None -> timezone

     

       26
       26
       +
             | _ -> end_timezone

     

       18
       27
        
           in

     

       19
       19
       -
           parse_end ~end_date ~end_time ~timezone ~end_timezone

     

       28
       28
       +
           parse_end ~end_date ~end_time ~end_timezone

     

       20
       29
        
         in

     

       21
       30
        
         let* recurrence =

     

       22
       31
        
           match recur with

     
···

       26
       35
        
           | None -> Ok None

     

       27
       36
        
         in

     

       28
       37
        
         let calendar_name = calendar_name in

     

       29
       29
       -
         let event =

     

       38
       38
       +
         let* event =

     

       30
       39
        
           Event.create ~fs

     

       31
       40
        
             ~calendar_dir_path:(Calendar_dir.get_path calendar_dir)

     

       32
       41
        
             ~summary ~start ?end_ ?location ?description ?recurrence calendar_name

+12 -3

bin/edit_cmd.ml

···

       16
       16
        
         let* start = parse_start ~start_date ~start_time ~timezone in

     

       17
       17
        
         let* end_ =

     

       18
       18
        
           let end_date =

     

       19
       19
       -
             match end_date with None -> start_date | Some e -> Some e

     

       19
       19
       +
             (* if we have an endtime and no end date default to start date *)

     

       20
       20
       +
             match (end_date, end_time) with

     

       21
       21
       +
             | None, Some _ -> start_date

     

       22
       22
       +
             | _ -> end_date

     

       23
       23
       +
           in

     

       24
       24
       +
           let end_timezone =

     

       25
       25
       +
             (* if we specify and end date and time without a end timezone, default to the start timezone *)

     

       26
       26
       +
             match (end_date, end_time, end_timezone) with

     

       27
       27
       +
             | Some _, Some _, None -> timezone

     

       28
       28
       +
             | _ -> end_timezone

     

       20
       29
        
           in

     

       21
       21
       -
           parse_end ~end_date ~end_time ~timezone ~end_timezone

     

       30
       30
       +
           parse_end ~end_date ~end_time ~end_timezone

     

       22
       31
        
         in

     

       23
       32
        
         let* recurrence =

     

       24
       33
        
           match recur with

     
···

       27
       36
        
               Ok (Some p)

     

       28
       37
        
           | None -> Ok None

     

       29
       38
        
         in

     

       30
       30
       -
         let modifed_event =

     

       39
       39
       +
         let* modifed_event =

     

       31
       40
        
           Event.edit ?summary ?start ?end_ ?location ?description ?recurrence event

     

       32
       41
        
         in

     

       33
       42
        
         let* _ = Calendar_dir.edit_event ~fs calendar_dir modifed_event in

+23 -25

bin/event_args.ml

···

       119
       119
        
               match start_time with

     

       120
       120
        
               | None -> Ok ()

     

       121
       121
        
               | Some _ ->

     

       122
       122
       -
                   Error (`Msg "Can't specify an start time without an end date")

     

       122
       122
       +
                   Error (`Msg "Can't specify an start time without a start date")

     

       123
       123
        
             in

     

       124
       124
        
             let* _ =

     

       125
       125
        
               match timezone with

     
···

       152
       152
        
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date

     

       153
       153
        
                         ~time:start_time `From

     

       154
       154
        
                     in

     

       155
       155
       -
                     Ok (Some (Icalendar.Params.empty, `Datetime (`With_tzid (datetime, (false, tzid)))))

     

       155
       155
       +
                     Ok

     

       156
       156
       +
                       (Some

     

       157
       157
       +
                          ( Icalendar.Params.empty,

     

       158
       158
       +
                            `Datetime (`With_tzid (datetime, (false, tzid))) ))

     

       156
       159
        
                 | Some "FLOATING" ->

     

       157
       160
        
                     let* datetime =

     

       158
       161
        
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date

     
···

       170
       173
        
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date

     

       171
       174
        
                         ~time:start_time `From

     

       172
       175
        
                     in

     

       173
       173
       -
                     Ok (Some (Icalendar.Params.empty, `Datetime (`With_tzid (datetime, (false, tzid)))))))

     

       176
       176
       +
                     Ok

     

       177
       177
       +
                       (Some

     

       178
       178
       +
                          ( Icalendar.Params.empty,

     

       179
       179
       +
                            `Datetime (`With_tzid (datetime, (false, tzid))) ))))

     

       174
       180
        
       

     

       175
       175
       -
       let parse_end ~end_date ~end_time ~timezone ~end_timezone =

     

       181
       181
       +
       let parse_end ~end_date ~end_time ~end_timezone =

     

       176
       182
        
         let ( let* ) = Result.bind in

     

       177
       177
       -
         let* _ =

     

       178
       178
       -
           match timezone with

     

       179
       179
       -
           | None -> Ok ()

     

       180
       180
       -
           | Some tzid -> (

     

       181
       181
       -
               match Timedesc.Time_zone.make tzid with

     

       182
       182
       -
               | Some _ -> Ok ()

     

       183
       183
       -
               | None ->

     

       184
       184
       -
                   Error (`Msg (Printf.sprintf "Warning: Unknown timezone %s" tzid)))

     

       185
       185
       -
         in

     

       186
       183
        
         let* _ =

     

       187
       184
        
           match end_timezone with

     

       188
       185
        
           | None -> Ok ()

     
···

       202
       199
        
             let* _ =

     

       203
       200
        
               match end_timezone with

     

       204
       201
        
               | None -> Ok ()

     

       205
       205
       -
               | Some _ -> Error (`Msg "Can't specify a timezone without a end time")

     

       202
       202
       +
               | Some _ ->

     

       203
       203
       +
                   Error (`Msg "Can't specify an end timezone without an end date")

     

       206
       204
        
             in

     

       207
       205
        
             Ok None

     

       208
       206
        
         | Some end_date -> (

     

       209
       207
        
             match end_time with

     

       210
       208
        
             | None ->

     

       211
       209
        
                 let* _ =

     

       212
       212
       -
                   match (timezone, end_timezone) with

     

       213
       213
       -
                   | None, None -> Ok ()

     

       214
       214
       -
                   | Some _, None ->

     

       215
       215
       -
                       Error (`Msg "Can't specify a timezone without a end time")

     

       216
       216
       -
                   | _ ->

     

       210
       210
       +
                   match end_timezone with

     

       211
       211
       +
                   | Some _ ->

     

       217
       212
        
                       Error (`Msg "Can't specify an end timezone without a end time")

     

       213
       213
       +
                   | _ -> Ok ()

     

       218
       214
        
                 in

     

       219
       215
        
                 let* ptime =

     

       220
       216
        
                   Date.parse_date end_date ~tz:Timedesc.Time_zone.utc `From

     
···

       222
       218
        
                 (* DTEND;VALUE=DATE the event ends at the start of the specified date *)

     

       223
       219
        
                 let ptime = Date.add_days ptime 1 in

     

       224
       220
        
                 let date = Ptime.to_date ptime in

     

       225
       225
       -
                 Ok (Some (`Dtend (Icalendar.Params.singleton Valuetype `Date, `Date date)))

     

       221
       221
       +
                 Ok

     

       222
       222
       +
                   (Some

     

       223
       223
       +
                      (`Dtend (Icalendar.Params.singleton Valuetype `Date, `Date date)))

     

       226
       224
        
             | Some end_time -> (

     

       227
       227
       -
                 match (timezone, end_timezone) with

     

       228
       228
       -
                 | None, None ->

     

       225
       225
       +
                 match end_timezone with

     

       226
       226
       +
                 | None ->

     

       229
       227
        
                     let* tzid =

     

       230
       228
        
                       match Timedesc.Time_zone.local () with

     

       231
       229
        
                       | Some tz -> Ok (Timedesc.Time_zone.name tz)

     
···

       240
       238
        
                          (`Dtend

     

       241
       239
        
                             ( Icalendar.Params.empty,

     

       242
       240
        
                               `Datetime (`With_tzid (datetime, (false, tzid))) )))

     

       243
       243
       -
                 | _, Some "FLOATING" | Some "FLOATING", None ->

     

       241
       241
       +
                 | Some "FLOATING" ->

     

       244
       242
        
                     let* datetime =

     

       245
       243
        
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date

     

       246
       244
        
                         ~time:end_time `From

     
···

       248
       246
        
                     Ok

     

       249
       247
        
                       (Some

     

       250
       248
        
                          (`Dtend (Icalendar.Params.empty, `Datetime (`Local datetime))))

     

       251
       251
       -
                 | _, Some "UTC" | Some "UTC", None ->

     

       249
       249
       +
                 | Some "UTC" ->

     

       252
       250
        
                     let* datetime =

     

       253
       251
        
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date

     

       254
       252
        
                         ~time:end_time `From

     
···

       256
       254
        
                     Ok

     

       257
       255
        
                       (Some

     

       258
       256
        
                          (`Dtend (Icalendar.Params.empty, `Datetime (`Utc datetime))))

     

       259
       259
       -
                 | _, Some tzid | Some tzid, _ ->

     

       257
       257
       +
                 | Some tzid ->

     

       260
       258
        
                     let* datetime =

     

       261
       259
        
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date

     

       262
       260
        
                         ~time:end_time `From

+22 -5

lib/event.ml

···

       16
       16
        
         Uuidm.to_string uuid

     

       17
       17
        
       

     

       18
       18
        
       let default_prodid = `Prodid (Params.empty, "-//Freumh//Caledonia//EN")

     

       19
       19
       +
       let ( let* ) = Result.bind

     

       19
       20
        
       

     

       20
       21
        
       let create ~(fs : Eio.Fs.dir_ty Eio.Path.t) ~calendar_dir_path ~summary ~start

     

       21
       22
        
           ?end_ ?location ?description ?recurrence calendar_name =

     
···

       28
       29
        
         in

     

       29
       30
        
         let dtstart = start in

     

       30
       31
        
         let dtend_or_duration = end_ in

     

       32
       32
       +
         let* _ =

     

       33
       33
       +
           match (dtstart, dtend_or_duration) with

     

       34
       34
       +
           | (_, `Date _), Some (`Dtend (_, `Datetime _)) ->

     

       35
       35
       +
               Error (`Msg "If the start is a date the end must also be a date.")

     

       36
       36
       +
           | (_, `Datetime _), Some (`Dtend (_, `Date _)) ->

     

       37
       37
       +
               Error

     

       38
       38
       +
                 (`Msg "If the start is a datetime the end must also be a datetime.")

     

       39
       39
       +
           | _ -> Ok ()

     

       40
       40
       +
         in

     

       31
       41
        
         let rrule = Option.map (fun r -> (Params.empty, r)) recurrence in

     

       32
       42
        
         let now = Ptime_clock.now () in

     

       33
       43
        
         let props = [ `Summary (Params.empty, summary) ] in

     
···

       57
       67
        
           let components = [ `Event event ] in

     

       58
       68
        
           (props, components)

     

       59
       69
        
         in

     

       60
       60
       -
         { calendar_name; file; event; calendar }

     

       70
       70
       +
         Ok { calendar_name; file; event; calendar }

     

       61
       71
        
       

     

       62
       72
        
       let edit ?summary ?start ?end_ ?location ?description ?recurrence t =

     

       63
       73
        
         let now = Ptime_clock.now () in

     

       64
       74
        
         let uid = t.event.uid in

     

       65
       65
       -
         let dtstart =

     

       66
       66
       -
           match start with None -> t.event.dtstart | Some s -> s

     

       67
       67
       -
         in

     

       75
       75
       +
         let dtstart = match start with None -> t.event.dtstart | Some s -> s in

     

       68
       76
        
         let dtend_or_duration =

     

       69
       77
        
           match end_ with None -> t.event.dtend_or_duration | Some _ -> end_

     

       78
       78
       +
         in

     

       79
       79
       +
         let* _ =

     

       80
       80
       +
           match (dtstart, dtend_or_duration) with

     

       81
       81
       +
           | (_, `Date _), Some (`Dtend (_, `Datetime _)) ->

     

       82
       82
       +
               Error (`Msg "If the start is a date the end must also be a date.")

     

       83
       83
       +
           | (_, `Datetime _), Some (`Dtend (_, `Date _)) ->

     

       84
       84
       +
               Error

     

       85
       85
       +
                 (`Msg "If the start is a datetime the end must also be a datetime.")

     

       86
       86
       +
           | _ -> Ok ()

     

       70
       87
        
         in

     

       71
       88
        
         let rrule =

     

       72
       89
        
           match recurrence with

     
···

       113
       130
        
         let calendar_name = t.calendar_name in

     

       114
       131
        
         let file = t.file in

     

       115
       132
        
         let calendar = t.calendar in

     

       116
       116
       -
         { calendar_name; file; event; calendar }

     

       133
       133
       +
         Ok { calendar_name; file; event; calendar }

     

       117
       134
        
       

     

       118
       135
        
       let events_of_icalendar calendar_name ~file calendar =

     

       119
       136
        
         let remove_dup_ids lst =

+2 -2

lib/event.mli

···

       20
       20
        
         ?description:string ->

     

       21
       21
        
         ?recurrence:Icalendar.recurrence ->

     

       22
       22
        
         string ->

     

       23
       23
       -
         t

     

       23
       23
       +
         (t, [> `Msg of string ]) result

     

       24
       24
        
       (** Create a new event with required properties.

     

       25
       25
        
       

     

       26
       26
        
           The start and end times can be specified as Icalendar.timestamp values,

     
···

       39
       39
        
         ?description:string ->

     

       40
       40
        
         ?recurrence:Icalendar.recurrence ->

     

       41
       41
        
         t ->

     

       42
       42
       -
         t

     

       42
       42
       +
         (t, [> `Msg of string ]) result

     

       43
       43
        
       (** Edit an existing event. *)

     

       44
       44
        
       

     

       45
       45
        
       val events_of_icalendar :

+22 -17

test/test_query.ml

···

       142
       142
        
         in

     

       143
       143
        
         [

     

       144
       144
        
           (* Event with text in all fields *)

     

       145
       145
       -
           create_test_event ~calendar_name:"search_test" ~summary:"Project Meeting"

     

       146
       146
       -
             ~description:"Weekly project status meeting with team"

     

       147
       147
       -
             ~location:"Conference Room A"

     

       148
       148
       -
             ~start:(`Datetime (`Utc fixed_date));

     

       145
       145
       +
           Result.get_ok

     

       146
       146
       +
           @@ create_test_event ~calendar_name:"search_test" ~summary:"Project Meeting"

     

       147
       147
       +
                ~description:"Weekly project status meeting with team"

     

       148
       148
       +
                ~location:"Conference Room A"

     

       149
       149
       +
                ~start:(Icalendar.Params.empty, `Datetime (`Utc fixed_date));

     

       149
       150
        
           (* Event with mixed case to test case insensitivity *)

     

       150
       150
       -
           create_test_event ~calendar_name:"search_test" ~summary:"IMPORTANT Meeting"

     

       151
       151
       -
             ~description:"Critical project review with stakeholders"

     

       152
       152
       -
             ~location:"Executive Suite"

     

       153
       153
       -
             ~start:(`Datetime (`Utc fixed_date));

     

       151
       151
       +
           Result.get_ok

     

       152
       152
       +
           @@ create_test_event ~calendar_name:"search_test"

     

       153
       153
       +
                ~summary:"IMPORTANT Meeting"

     

       154
       154
       +
                ~description:"Critical project review with stakeholders"

     

       155
       155
       +
                ~location:"Executive Suite"

     

       156
       156
       +
                ~start:(Icalendar.Params.empty, `Datetime (`Utc fixed_date));

     

       154
       157
        
           (* Event with word fragments *)

     

       155
       155
       -
           create_test_event ~calendar_name:"search_test" ~summary:"Conference Call"

     

       156
       156
       -
             ~description:"International conference preparation"

     

       157
       157
       -
             ~location:"Remote Meeting Room"

     

       158
       158
       -
             ~start:(`Datetime (`Utc fixed_date));

     

       158
       158
       +
           Result.get_ok

     

       159
       159
       +
           @@ create_test_event ~calendar_name:"search_test" ~summary:"Conference Call"

     

       160
       160
       +
                ~description:"International conference preparation"

     

       161
       161
       +
                ~location:"Remote Meeting Room"

     

       162
       162
       +
                ~start:(Icalendar.Params.empty, `Datetime (`Utc fixed_date));

     

       159
       163
        
           (* Event with unique text in each field *)

     

       160
       160
       -
           create_test_event ~calendar_name:"search_test"

     

       161
       161
       -
             ~summary:"Workshop on Testing"

     

       162
       162
       -
             ~description:"Quality Assurance techniques and practices"

     

       163
       163
       -
             ~location:"Training Center"

     

       164
       164
       -
             ~start:(`Datetime (`Utc fixed_date));

     

       164
       164
       +
           Result.get_ok

     

       165
       165
       +
           @@ create_test_event ~calendar_name:"search_test"

     

       166
       166
       +
                ~summary:"Workshop on Testing"

     

       167
       167
       +
                ~description:"Quality Assurance techniques and practices"

     

       168
       168
       +
                ~location:"Training Center"

     

       169
       169
       +
                ~start:(Icalendar.Params.empty, `Datetime (`Utc fixed_date));

     

       165
       170
        
         ]

     

       166
       171
        
       

     

       167
       172
        
       (* Test helper to verify if a list of events contains an event with a given summary *)