comparing 174d468818046009dcf08f0bd8a25eeba51668a0 and main on ryan.freumh.org/caledonia

+12

CHANGELOG.md

···

       1
       +
       

     

       2
       +
       ### 0.4.0

     

       3
       +
       

     

       4
       +
       - Emacs front end that communicates with a server mode via an S-expression protocol

     

       5
       +
       

     

       6
       +
       ### 0.3.1

     

       7
       +
       

     

       8
       +
       - various bugfixes and tweaks

     

       9
       +
       

     

       10
       +
       ### 0.3.0

     

       11
       +
       

     

       12
       +
       - timezone support

     

       13
        
       

     

       14
        
       ### 0.2.0

     

       15

+43 -4

README.md

···

       1
       -
       # 📅 Caledonia 🏴󠁧󠁢󠁳󠁣󠁴󠁿

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       2
        
       

     

       3
       -
       Caledonia is a command-line calendar client.

     

       4
       -
       Currently, it operates on directories of [`.ics`](https://datatracker.ietf.org/doc/html/rfc5545) files (as managed by tools like [vdirsyncer](https://github.com/pimutils/vdirsyncer)).

     

       5
       -
       It supports the `list`, `search`, `show`, `add`, `delete`, and `edit` subcommands.

     

       6
        
       See [TODO](./TODO.org) for future plans.

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       7
        
       

     

       8
        
       ## Configuration

     

       9

···

       1
       +
       # Caledonia

     

       2
       +
       

     

       3
       +
       Caledonia is a calendar client with command-line and Emacs front-ends.

     

       4
       +
       It operates on a [vdir](https://pimutils.org/specs/vdir/) directory of [`.ics`](https://datatracker.ietf.org/doc/html/rfc5545) files as managed by tools like [vdirsyncer](https://github.com/pimutils/vdirsyncer), which allows it to interact with CalDAV servers.

     

       5
       +
       

     

       6
       +
       The command-line has the `list`, `search`, `show`, `add`, `delete`, and `edit` subcommands, and has full timezone support.

     

       7
       +
       

     

       8
       +
       An example `list` invocation is,

     

       9
       +
       

     

       10
       +
       ```

     

       11
       +
       $ caled list

     

       12
       +
       personal   2025-04-04 Fri 13:00 - 14:00 (America/New_York) New York 8am meeting      054bb346-b24f-49f4-80ab-fcb6040c19a7

     

       13
       +
       family     2025-04-06 Sun 21:00 - 22:00 (UTC)              Family chat @Video call   3B84B125-6EFC-4E1C-B35A-97EFCA61110E

     

       14
       +
       work       2025-04-09 Wed 15:00 - 16:00 (Europe/London)    Weekly Meeting            4adcb98dfc1848601e38c2ea55edf71fab786c674d7b72d4c263053b23560a8d

     

       15
       +
       personal   2025-04-10 Thu 11:00 - 12:00 (UTC)              Dentist                   ccef66cd4d1e87ae7319097f027f8322de67f758

     

       16
       +
       family     2025-04-13 Sun 21:00 - 22:00 (UTC)              Family chat @Video call   3B84B125-6EFC-4E1C-B35A-97EFCA61110E

     

       17
       +
       personal   2025-04-15 Tue - 2025-04-17 Thu                 John Doe in town          33cf18ec-90d3-40f8-8335-f338fbdb395b

     

       18
       +
       personal   2025-04-15 Tue 21:00 - 21:30 (UTC)              Grandma call              8601c255-65fc-4bc9-baa9-465dd7b4cd7d

     

       19
       +
       work       2025-04-16 Wed 15:00 - 16:00 (Europe/London)    Weekly Meeting            4adcb98dfc1848601e38c2ea55edf71fab786c674d7b72d4c263053b23560a8d

     

       20
       +
       personal   2025-04-19 Sat                                  Jane Doe's birthday       7hm4laoadevr1ene8o876f2576@google.com

     

       21
       +
       family     2025-04-20 Sun 21:00 - 22:00 (UTC)              Family chat @Video call   3B84B125-6EFC-4E1C-B35A-97EFCA61110E

     

       22
       +
       personal   2025-04-22 Tue 21:00 - 21:30 (UTC)              Grandma call              8601c255-65fc-4bc9-baa9-465dd7b4cd7d

     

       23
       +
       work       2025-04-23 Wed 15:00 - 16:00 (Europe/London)    Weekly Meeting            4adcb98dfc1848601e38c2ea55edf71fab786c674d7b72d4c263053b23560a8d

     

       24
       +
       family     2025-04-27 Sun 21:00 - 22:00 (UTC)              Family chat @Video call   3B84B125-6EFC-4E1C-B35A-97EFCA61110E

     

       25
       +
       personal   2025-04-29 Tue 21:00 - 21:30 (UTC)              Grandma call              8601c255-65fc-4bc9-baa9-465dd7b4cd7d

     

       26
       +
       work       2025-04-30 Wed 15:00 - 16:00 (Europe/London)    Weekly Meeting            4adcb98dfc1848601e38c2ea55edf71fab786c674d7b72d4c263053b23560a8d

     

       27
       +
       ```

     

       28
        
       

     

       29
       +
       The Emacs client is defined in [./emacs](./emacs) and communicates with `caled server` using a [S-expression](https://en.wikipedia.org/wiki/S-expression) based protocol.

     

       30
       +
       

     

       0
        
       
     

       31
        
       See [TODO](./TODO.org) for future plans.

     

       32
       +
       

     

       33
       +
       ## Installation

     

       34
       +
       

     

       35
       +
       With [opam](https://opam.ocaml.org/),

     

       36
       +
       

     

       37
       +
       ```

     

       38
       +
       $ opam install .

     

       39
       +
       ```

     

       40
       +
       

     

       41
       +
       With [Nix](https://nixos.org/),

     

       42
       +
       

     

       43
       +
       ```

     

       44
       +
       $ nix shell 'git+https://tangled.sh/@ryan.freumh.org/caledonia?ref=main'

     

       45
       +
       ```

     

       46
        
       

     

       47
        
       ## Configuration

     

       48

+28 -11

TODO.org

···

       1
        
       * DONE list/search events

     

       2
        
       * DONE add/remove events

     

       3
       -
       ** TODO support more options in creating events, e.g. event duration

     

       4
        
       * DONE edit events

     

       5
       -
       * TODO diagnose events failing to parse

     

       6
       -
       * TODO timezones

     

       7
       -
       timerer

     

       8
       -
       * TODO [[https://github.com/robur-coop/icalendar/pull/13][handle RECURRENCE-ID]]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       9
        
       * TODO CalDAV syncing

     

       10
       -
       Currently, you can use [[https://github.com/pimutils/vdirsyncer][vdirsyncer]]

     

       11
       -
       * TODO support a DSL of date queries (e.g. query for every event on a Monday)

     

       12
       -
       * TODO support querying times as well as dates

     

       13
        
       * TODO custom date/time formatting

     

       14
       -
       * TODO support querying regex

     

       15
       -
       * TODO server mode

     

       16
       -
       and maybe hold =Event='s in-memory in a =Collection= instead of parsing them for every =Query=

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
        
       * DONE list/search events

     

       2
        
       * DONE add/remove events

     

       0
        
       
     

       3
        
       * DONE edit events

     

       4
       +
       * DONE timezones

     

       5
       +
       * DONE diagnose events failing to parse [[https://github.com/robur-coop/icalendar/issues/14]]

     

       6
       +
       * DONE [[https://github.com/robur-coop/icalendar/pull/13][handle RECURRENCE-ID]]

     

       7
       +
       * DONE [[https://github.com/robur-coop/icalendar/issues/15][RRULE with local datetime]]

     

       8
       +
       * DONE server mode

     

       9
       +
       * DONE hold =Event='s in-memory instead of parsing them for every =Query=

     

       10
       +
       * TODO support vdir metadata

     

       11
       +
       * TODO add timezone all date functions

     

       12
       +
       * TODO allow editing recurrence-ids

     

       13
       +
       * TODO support specifying duration

     

       14
        
       * TODO CalDAV syncing

     

       15
       +
       * TODO support complex datetime queries

     

       0
        
       
     

       0
        
       
     

       16
        
       * TODO custom date/time formatting

     

       17
       +
       * TODO support querying text with regex

     

       18
       +
       * TODO support VTIMEZONE

     

       19
       +
       * TODO support VALARMS

     

       20
       +
       * TODO support VOTODS

     

       21
       +
       * TODO support VCARDS

     

       22
       +
       * TODO support VJOURNAL

     

       23
       +
       * TODO implement TUI front end with something like [[https://github.com/leostera/minttea][minttea]]

     

       24
       +
       * TODO implement an emacs front end, like mu4e to mu

     

       25
       +
       ** DONE listing, searching, querying

     

       26
       +
       ** DONE show details

     

       27
       +
       ** DONE show file

     

       28
       +
       ** DONE refresh

     

       29
       +
       ** DONE list possible calendars

     

       30
       +
       ** DONE add functions and bindings to change query parameters on the fly

     

       31
       +
       ** TODO timezone support

     

       32
       +
       ** TODO support adding, deleting, and editing events

     

       33
       +
       ** TODO add a org-agenda style view for caledonia-list

+65 -149

bin/add_cmd.ml

···

       1
        
       open Cmdliner

     

       2
        
       open Caledonia_lib

     

       3
       -
       open Query_args

     

       4
        
       

     

       5
        
       let run ~summary ~start_date ~start_time ~end_date ~end_time ~location

     

       6
       -
           ~description ~recur ~collection ~today ~tomorrow ~week ~month ~fs

     

       7
       -
           calendar_dir =

     

       8
        
         let ( let* ) = Result.bind in

     

       9
       -
         let* start_date =

     

       10
       -
           match

     

       11
       -
             ( Query_args.convert_relative_date ~today ~tomorrow ~week ~month,

     

       12
       -
               start_date )

     

       13
       -
           with

     

       14
       -
           | Some date, _ -> Ok date

     

       15
       -
           | None, Some date -> Ok date

     

       16
       -
           | None, None -> Error (`Msg "Start date is required")

     

       17
       -
         in

     

       18
        
         let* start =

     

       19
       -
           Date.parse_date_time_opt ~date:start_date ?time:start_time `From

     

       20
       -
         in

     

       21
       -
         let end_date =

     

       22
       -
           match

     

       23
       -
             (Query_args.convert_relative_date ~today ~tomorrow ~week ~month, end_date)

     

       24
       -
           with

     

       25
       -
           | Some date, _ -> Some date

     

       26
       -
           | None, Some date -> Some date

     

       27
       -
           | None, None -> None

     

       28
        
         in

     

       29
        
         let* end_ =

     

       30
       -
           match end_date with

     

       31
       -
           | None -> Ok None

     

       32
       -
           | Some end_date ->

     

       33
       -
               let* end_dt =

     

       34
       -
                 Date.parse_date_time_opt ~date:end_date ?time:end_time `To

     

       35
       -
               in

     

       36
       -
               Ok (Some end_dt)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       37
        
         in

     

       38
        
         let* recurrence =

     

       39
        
           match recur with

     

       40
        
           | Some r ->

     

       41
       -
               let* p = Recur.parse_recurrence r in

     

       42
        
               Ok (Some p)

     

       43
        
           | None -> Ok None

     

       44
        
         in

     

       45
       -
         let collection = Collection.Col collection in

     

       46
       -
         let event =

     

       47
       -
           Event.create ~summary ~start ?end_ ?location ?description ?recurrence

     

       48
       -
             collection

     

       0
        
       
     

       49
        
         in

     

       50
       -
         let* _ = Calendar_dir.add_event ~fs calendar_dir event in

     

       0
        
       
     

       51
        
         Printf.printf "Event created with ID: %s\n" (Event.get_id event);

     

       52
        
         Ok ()

     

       53
        
       

     

       54
       -
       let collection_arg =

     

       55
       -
         let doc = "Calendar to add the event to" in

     

       56
       -
         Arg.(

     

       57
       -
           required

     

       58
       -
           & opt (some string) None

     

       59
       -
           & info [ "calendar"; "c" ] ~docv:"CALENDAR" ~doc)

     

       60
       -
       

     

       61
       -
       let summary_arg =

     

       62
       -
         let doc = "Event summary/title" in

     

       63
       -
         Arg.(required & pos 0 (some string) None & info [] ~docv:"SUMMARY" ~doc)

     

       64
       -
       

     

       65
       -
       let start_date_arg =

     

       66
       -
         let doc = "Event start date (YYYY-MM-DD)" in

     

       67
       -
         Arg.(value & opt (some string) None & info [ "date" ] ~docv:"DATE" ~doc)

     

       68
       -
       

     

       69
       -
       let start_time_arg =

     

       70
       -
         let doc = "Event start time (HH:MM)" in

     

       71
       -
         Arg.(value & opt (some string) None & info [ "time"; "t" ] ~docv:"TIME" ~doc)

     

       72
       -
       

     

       73
       -
       let end_date_arg =

     

       74
       -
         let doc = "Event end date (YYYY-MM-DD)" in

     

       75
       -
         Arg.(

     

       76
       -
           value

     

       77
       -
           & opt (some string) None

     

       78
       -
           & info [ "end-date"; "e" ] ~docv:"END_DATE" ~doc)

     

       79
       -
       

     

       80
       -
       let end_time_arg =

     

       81
       -
         let doc = "Event end time (HH:MM)" in

     

       82
       -
         Arg.(

     

       83
       -
           value & opt (some string) None & info [ "end-time" ] ~docv:"END_TIME" ~doc)

     

       84
       -
       

     

       85
       -
       let location_arg =

     

       86
       -
         let doc = "Event location" in

     

       87
       -
         Arg.(

     

       88
       -
           value

     

       89
       -
           & opt (some string) None

     

       90
       -
           & info [ "location"; "l" ] ~docv:"LOCATION" ~doc)

     

       91
       -
       

     

       92
       -
       let description_arg =

     

       93
       -
         let doc = "Event description" in

     

       94
       -
         Arg.(

     

       95
       -
           value

     

       96
       -
           & opt (some string) None

     

       97
       -
           & info [ "description"; "D" ] ~docv:"DESCRIPTION" ~doc)

     

       98
       -
       

     

       99
       -
       let recur_arg =

     

       100
       -
         let doc = "See RECURRENCE section" in

     

       101
       -
         Arg.(

     

       102
       -
           value & opt (some string) None & info [ "recur"; "r" ] ~docv:"RECUR" ~doc)

     

       103
       -
       

     

       104
        
       let cmd ~fs calendar_dir =

     

       105
        
         let run summary start_date start_time end_date end_time location description

     

       106
       -
             recur collection today tomorrow week month =

     

       107
        
           match

     

       108
        
             run ~summary ~start_date ~start_time ~end_date ~end_time ~location

     

       109
       -
               ~description ~recur ~collection ~today ~tomorrow ~week ~month ~fs

     

       110
        
               calendar_dir

     

       111
        
           with

     

       112
        
           | Error (`Msg msg) ->

     
···

       116
        
         in

     

       117
        
         let term =

     

       118
        
           Term.(

     

       119
       -
             const run $ summary_arg $ start_date_arg $ start_time_arg $ end_date_arg

     

       120
       -
             $ end_time_arg $ location_arg $ description_arg $ recur_arg

     

       121
       -
             $ collection_arg $ today_arg $ tomorrow_arg $ week_arg $ month_arg)

     

       122
        
         in

     

       123
        
         let doc = "Add a new calendar event" in

     

       124
        
         let man =

     
···

       128
        
             `P

     

       129
        
               "Specify the event summary (title) as the first argument, and use \

     

       130
        
                options to set other details.";

     

       131
       -
             `P "Note all times are in Coordinated Universal Time (UTC).";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       132
        
             `S Manpage.s_options;

     

       133
        
           ]

     

       134
       -
           @ date_format_manpage_entries

     

       135
       -
           @ [

     

       136
       -
               `S Manpage.s_examples;

     

       137
       -
               `I

     

       138
       -
                 ( "Add a simple event for today:",

     

       139
       -
                   "caled add \"Team Meeting\" --today --time 14:00" );

     

       140
       -
               `I

     

       141
       -
                 ( "Add an event with a specific date and time:",

     

       142
       -
                   "caled add \"Dentist Appointment\" --date 2025-04-15 --time 10:30"

     

       143
       -
                 );

     

       144
       -
               `I

     

       145
       -
                 ( "Add an event with an end time:",

     

       146
       -
                   "caled add \"Conference\" --date 2025-05-20 --time 09:00 \

     

       147
       -
                    --end-date 2025-05-22 --end-time 17:00" );

     

       148
       -
               `I

     

       149
       -
                 ( "Add an event with location and description:",

     

       150
       -
                   "caled add \"Lunch with Bob\" --date 2025-04-02 --time 12:30 \

     

       151
       -
                    --location \"Pasta Restaurant\" --description \"Discuss project \

     

       152
       -
                    plans\"" );

     

       153
       -
               `I

     

       154
       -
                 ( "Add an event to a specific calendar:",

     

       155
       -
                   "caled add \"Work Meeting\" --date 2025-04-03 --time 15:00 \

     

       156
       -
                    --calendar work" );

     

       157
       -
               `S "RECURRENCE";

     

       158
       -
               `P

     

       159
       -
                 "Recurrence rule in iCalendar RFC5545 format. The FREQ part is \

     

       160
       -
                  required.";

     

       161
       -
               `I ("FREQ=<frequency>", "DAILY, WEEKLY, MONTHLY, or YEARLY (required)");

     

       162
       -
               `I

     

       163
       -
                 ( "COUNT=<number>",

     

       164
       -
                   "Limit to this many occurrences (optional, cannot be used with \

     

       165
       -
                    UNTIL)" );

     

       166
       -
               `I

     

       167
       -
                 ( "UNTIL=<date>",

     

       168
       -
                   "Repeat until this date (optional, cannot be used with COUNT)" );

     

       169
       -
               `I

     

       170
       -
                 ( "INTERVAL=<number>",

     

       171
       -
                   "Interval between occurrences, e.g., 2 for every other (optional)"

     

       172
       -
                 );

     

       173
       -
               `I

     

       174
       -
                 ( "BYDAY=<dayspec>",

     

       175
       -
                   "Specific days, e.g., MO,WE,FR or 1MO (first Monday) (optional)" );

     

       176
       -
               `I

     

       177
       -
                 ( "BYMONTHDAY=<daynum>",

     

       178
       -
                   "Day of month, e.g., 1,15 or -1 (last day) (optional)" );

     

       179
       -
               `I

     

       180
       -
                 ( "BYMONTH=<monthnum>",

     

       181
       -
                   "Month number, e.g., 1,6,12 for Jan,Jun,Dec (optional)" );

     

       182
       -
               `P "Examples:";

     

       183
       -
               `I ("FREQ=DAILY;COUNT=5", "Daily for 5 occurrences");

     

       184
       -
               `I ("FREQ=WEEKLY;INTERVAL=2", "Every other week indefinitely");

     

       185
       -
               `I ("FREQ=WEEKLY;BYDAY=MO,WE,FR", "Every Monday, Wednesday, Friday");

     

       186
       -
               `I ("FREQ=MONTHLY;BYDAY=1MO", "First Monday of every month");

     

       187
       -
               `I

     

       188
       -
                 ( "FREQ=YEARLY;BYMONTH=1;BYMONTHDAY=1",

     

       189
       -
                   "Every January 1st (New Year's Day)" );

     

       190
       -
               `I ("FREQ=MONTHLY;BYMONTHDAY=-1", "Last day of every month");

     

       191
       -
             ]

     

       192
        
         in

     

       193
       -
         let info = Cmd.info "add" ~doc ~man in

     

       194
        
         Cmd.v info term

···

       1
        
       open Cmdliner

     

       2
        
       open Caledonia_lib

     

       3
       +
       open Event_args

     

       4
        
       

     

       5
        
       let run ~summary ~start_date ~start_time ~end_date ~end_time ~location

     

       6
       +
           ~description ~recur ~calendar_name ?timezone ?end_timezone ~fs calendar_dir

     

       7
       +
           =

     

       8
        
         let ( let* ) = Result.bind in

     

       9
       +
         let* start = parse_start ~start_date ~start_time ~timezone in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       10
        
         let* start =

     

       11
       +
           match start with

     

       12
       +
           | Some s -> Ok s

     

       13
       +
           | None -> Error (`Msg "Start date required")

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       14
        
         in

     

       15
        
         let* end_ =

     

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

     

       17
       +
           let end_date =

     

       18
       +
             match (end_date, end_time) with

     

       19
       +
             | None, Some _ -> start_date

     

       20
       +
             | _ -> end_date

     

       21
       +
           in

     

       22
       +
           (* if we have a start date and no end date default to start date *)

     

       23
       +
           let end_date =

     

       24
       +
             match (start_date, end_date) with

     

       25
       +
             | Some _, None -> start_date

     

       26
       +
             | _ -> end_date

     

       27
       +
           in

     

       28
       +
           let end_timezone =

     

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

     

       30
       +
             match (end_date, end_time, end_timezone) with

     

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

     

       32
       +
             | _ -> end_timezone

     

       33
       +
           in

     

       34
       +
           parse_end ~end_date ~end_time ~end_timezone

     

       35
        
         in

     

       36
        
         let* recurrence =

     

       37
        
           match recur with

     

       38
        
           | Some r ->

     

       39
       +
               let* p = parse_recurrence r in

     

       40
        
               Ok (Some p)

     

       41
        
           | None -> Ok None

     

       42
        
         in

     

       43
       +
         let calendar_name = calendar_name in

     

       44
       +
         let* event =

     

       45
       +
           Event.create ~fs

     

       46
       +
             ~calendar_dir_path:(Calendar_dir.get_path calendar_dir)

     

       47
       +
             ~summary ~start ?end_ ?location ?description ?recurrence calendar_name

     

       48
        
         in

     

       49
       +
         let* events = Calendar_dir.get_events ~fs calendar_dir in

     

       50
       +
         let* _ = Calendar_dir.add_event ~fs calendar_dir events event in

     

       51
        
         Printf.printf "Event created with ID: %s\n" (Event.get_id event);

     

       52
        
         Ok ()

     

       53
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       54
        
       let cmd ~fs calendar_dir =

     

       55
        
         let run summary start_date start_time end_date end_time location description

     

       56
       +
             recur calendar_name timezone end_timezone () =

     

       57
        
           match

     

       58
        
             run ~summary ~start_date ~start_time ~end_date ~end_time ~location

     

       59
       +
               ~description ~recur ~calendar_name ?timezone ?end_timezone ~fs

     

       60
        
               calendar_dir

     

       61
        
           with

     

       62
        
           | Error (`Msg msg) ->

     
···

       66
        
         in

     

       67
        
         let term =

     

       68
        
           Term.(

     

       69
       +
             const run $ required_summary_arg $ start_date_arg $ start_time_arg

     

       70
       +
             $ end_date_arg $ end_time_arg $ location_arg $ description_arg $ recur_arg

     

       71
       +
             $ calendar_name_arg $ timezone_arg $ end_timezone_arg)

     

       72
        
         in

     

       73
        
         let doc = "Add a new calendar event" in

     

       74
        
         let man =

     
···

       78
        
             `P

     

       79
        
               "Specify the event summary (title) as the first argument, and use \

     

       80
        
                options to set other details.";

     

       81
       +
             `S Manpage.s_examples;

     

       82
       +
             `I

     

       83
       +
               ( "Add a event for today:",

     

       84
       +
                 "caled add \"Meeting\" --date today --time 14:00" );

     

       85
       +
             `I

     

       86
       +
               ( "Add an event with a specific date and time:",

     

       87
       +
                 "caled add \"Dentist Appointment\" --date 2025-04-15 --time 10:30" );

     

       88
       +
             `I

     

       89
       +
               ( "Add an event with an end time:",

     

       90
       +
                 "caled add \"Conference\" --date 2025-05-20 --time 09:00 --end-date \

     

       91
       +
                  2025-05-22 --end-time 17:00" );

     

       92
       +
             `I

     

       93
       +
               ( "Add an event with location and description:",

     

       94
       +
                 "caled add \"Lunch with Bob\" --date 2025-04-02 --time 12:30 \

     

       95
       +
                  --location \"Pasta Restaurant\" --description \"Discuss project \

     

       96
       +
                  plans\"" );

     

       97
       +
             `I

     

       98
       +
               ( "Add an event to a specific calendar:",

     

       99
       +
                 "caled add \"Work Meeting\" --date 2025-04-03 --time 15:00 \

     

       100
       +
                  --calendar work" );

     

       101
        
             `S Manpage.s_options;

     

       102
        
           ]

     

       103
       +
           @ date_format_manpage_entries @ recurrence_format_manpage_entries

     

       104
       +
           @ [ `S Manpage.s_see_also ]

     

       105
       +
         in

     

       106
       +
         let exit_info =

     

       107
       +
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       108
        
         in

     

       109
       +
         let info = Cmd.info "add" ~doc ~man ~exits:exit_info in

     

       110
        
         Cmd.v info term

+13 -7

bin/delete_cmd.ml

···

       3
        
       

     

       4
        
       let run ~event_id ~fs calendar_dir =

     

       5
        
         let ( let* ) = Result.bind in

     

       6
       -
         let filter = Query.with_id event_id in

     

       7
       -
         let* results = Query.query_events ~fs calendar_dir ~filter () in

     

       0
        
       
     

       8
        
         let* event =

     

       9
       -
           match results with

     

       10
        
           | [ event ] -> Ok event

     

       11
        
           | [] -> Error (`Msg ("No events found found for id " ^ event_id))

     

       12
        
           | _ -> Error (`Msg ("More than one found for id " ^ event_id))

     

       13
        
         in

     

       14
       -
         let result = Calendar_dir.delete_event ~fs calendar_dir event in

     

       15
        
         match result with

     

       16
        
         | Error (`Msg msg) -> Error (`Msg msg)

     

       17
       -
         | Ok () ->

     

       18
        
             Printf.printf "Event %s successfully deleted.\n" event_id;

     

       19
        
             Ok ()

     

       20
        
       

     
···

       23
        
         Arg.(required & pos 0 (some string) None & info [] ~docv:"EVENT_ID" ~doc)

     

       24
        
       

     

       25
        
       let cmd ~fs calendar_dir =

     

       26
       -
         let run event_id =

     

       27
        
           match run ~event_id ~fs calendar_dir with

     

       28
        
           | Error (`Msg msg) ->

     

       29
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       40
        
             `S Manpage.s_examples;

     

       41
        
             `P "Delete an event:";

     

       42
        
             `P "  caled delete 12345678-1234-5678-1234-567812345678";

     

       0
        
       
     

       43
        
           ]

     

       0
        
       
     

       44
        
         in

     

       45
       -
         let info = Cmd.info "delete" ~doc ~man in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       46
        
         Cmd.v info term

···

       3
        
       

     

       4
        
       let run ~event_id ~fs calendar_dir =

     

       5
        
         let ( let* ) = Result.bind in

     

       6
       +
         let filter = Event.with_id event_id in

     

       7
       +
         let* events = Calendar_dir.get_events ~fs calendar_dir in

     

       8
       +
         let events = Event.query_without_recurrence events ~filter () in

     

       9
        
         let* event =

     

       10
       +
           match events with

     

       11
        
           | [ event ] -> Ok event

     

       12
        
           | [] -> Error (`Msg ("No events found found for id " ^ event_id))

     

       13
        
           | _ -> Error (`Msg ("More than one found for id " ^ event_id))

     

       14
        
         in

     

       15
       +
         let result = Calendar_dir.delete_event ~fs calendar_dir events event in

     

       16
        
         match result with

     

       17
        
         | Error (`Msg msg) -> Error (`Msg msg)

     

       18
       +
         | Ok _ ->

     

       19
        
             Printf.printf "Event %s successfully deleted.\n" event_id;

     

       20
        
             Ok ()

     

       21
        
       

     
···

       24
        
         Arg.(required & pos 0 (some string) None & info [] ~docv:"EVENT_ID" ~doc)

     

       25
        
       

     

       26
        
       let cmd ~fs calendar_dir =

     

       27
       +
         let run event_id () =

     

       28
        
           match run ~event_id ~fs calendar_dir with

     

       29
        
           | Error (`Msg msg) ->

     

       30
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       41
        
             `S Manpage.s_examples;

     

       42
        
             `P "Delete an event:";

     

       43
        
             `P "  caled delete 12345678-1234-5678-1234-567812345678";

     

       44
       +
             `S Manpage.s_options;

     

       45
        
           ]

     

       46
       +
           @ [ `S Manpage.s_see_also ]

     

       47
        
         in

     

       48
       +
         let exit_info =

     

       49
       +
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

     

       50
       +
         in

     

       51
       +
         let info = Cmd.info "delete" ~doc ~man ~exits:exit_info in

     

       52
        
         Cmd.v info term

+9 -4

bin/dune

···

       13
        
         ptime

     

       14
        
         ptime.clock.os

     

       15
        
         eio

     

       16
       -
         eio_main)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       17
        
        (modules

     

       18
        
         main

     

       0
        
       
     

       0
        
       
     

       19
        
         list_cmd

     

       20
        
         search_cmd

     

       21
       -
         query_args

     

       22
        
         add_cmd

     

       23
       -
         edit_cmd

     

       24
        
         delete_cmd

     

       25
       -
         show_cmd))

     

       0

···

       13
        
         ptime

     

       14
        
         ptime.clock.os

     

       15
        
         eio

     

       16
       +
         eio_main

     

       17
       +
         timere

     

       18
       +
         sexplib

     

       19
       +
         sexplib.unix)

     

       20
        
        (modules

     

       21
        
         main

     

       22
       +
         query_args

     

       23
       +
         event_args

     

       24
        
         list_cmd

     

       25
        
         search_cmd

     

       26
       +
         show_cmd

     

       27
        
         add_cmd

     

       0
        
       
     

       28
        
         delete_cmd

     

       29
       +
         edit_cmd

     

       30
       +
         server_cmd))

+50 -136

bin/edit_cmd.ml

···

       1
        
       open Cmdliner

     

       2
        
       open Caledonia_lib

     

       3
       -
       open Query_args

     

       4
        
       

     

       5
        
       let run ~event_id ~summary ~start_date ~start_time ~end_date ~end_time ~location

     

       6
       -
           ~description ~recur ~today ~tomorrow ~week ~month ~fs calendar_dir =

     

       7
        
         let ( let* ) = Result.bind in

     

       8
       -
         let filter = Query.with_id event_id in

     

       9
       -
         let* results = Query.query_events ~fs calendar_dir ~filter () in

     

       0
        
       
     

       10
        
         let* event =

     

       11
        
           match results with

     

       12
        
           | [ event ] -> Ok event

     

       13
        
           | [] -> Error (`Msg ("No events found found for id " ^ event_id))

     

       14
        
           | _ -> Error (`Msg ("More than one found for id " ^ event_id))

     

       15
        
         in

     

       16
       -
         let start_date =

     

       17
       -
           match

     

       18
       -
             ( Query_args.convert_relative_date ~today ~tomorrow ~week ~month,

     

       19
       -
               start_date )

     

       20
       -
           with

     

       21
       -
           | Some date, _ -> Some date

     

       22
       -
           | None, Some date -> Some date

     

       23
       -
           | None, None -> None

     

       24
       -
         in

     

       25
       -
         let* start =

     

       26
       -
           match start_date with

     

       27
       -
           | Some date ->

     

       28
       -
               let* d = Date.parse_date_time_opt ~date ?time:start_time `From in

     

       29
       -
               Ok (Some d)

     

       30
       -
           | None -> Ok None

     

       31
       -
         in

     

       32
       -
         let end_date =

     

       33
       -
           match

     

       34
       -
             (Query_args.convert_relative_date ~today ~tomorrow ~week ~month, end_date)

     

       35
       -
           with

     

       36
       -
           | Some date, _ -> Some date

     

       37
       -
           | None, Some date -> Some date

     

       38
       -
           | None, None -> None

     

       39
       -
         in

     

       40
        
         let* end_ =

     

       41
       -
           match end_date with

     

       42
       -
           | None -> Ok None

     

       43
       -
           | Some end_date ->

     

       44
       -
               let* end_dt =

     

       45
       -
                 Date.parse_date_time_opt ~date:end_date ?time:end_time `To

     

       46
       -
               in

     

       47
       -
               Ok (Some end_dt)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       48
        
         in

     

       49
        
         let* recurrence =

     

       50
        
           match recur with

     

       51
        
           | Some r ->

     

       52
       -
               let* p = Recur.parse_recurrence r in

     

       53
        
               Ok (Some p)

     

       54
        
           | None -> Ok None

     

       55
        
         in

     

       56
       -
         let modifed_event =

     

       57
        
           Event.edit ?summary ?start ?end_ ?location ?description ?recurrence event

     

       58
        
         in

     

       59
       -
         let* _ = Calendar_dir.edit_event ~fs calendar_dir modifed_event in

     

       60
        
         Printf.printf "Event %s updated.\n" event_id;

     

       61
        
         Ok ()

     

       62
        
       

     
···

       64
        
         let doc = "ID of the event to edit" in

     

       65
        
         Arg.(required & pos 0 (some string) None & info [] ~docv:"EVENT_ID" ~doc)

     

       66
        
       

     

       67
       -
       let summary_arg =

     

       68
       -
         let doc = "New event summary/title" in

     

       69
       -
         Arg.(

     

       70
       -
           value

     

       71
       -
           & opt (some string) None

     

       72
       -
           & info [ "summary"; "s" ] ~docv:"SUMMARY" ~doc)

     

       73
       -
       

     

       74
       -
       let start_date_arg =

     

       75
       -
         let doc = "New event start date (YYYY-MM-DD)" in

     

       76
       -
         Arg.(value & opt (some string) None & info [ "date" ] ~docv:"DATE" ~doc)

     

       77
       -
       

     

       78
       -
       let start_time_arg =

     

       79
       -
         let doc = "New event start time (HH:MM)" in

     

       80
       -
         Arg.(value & opt (some string) None & info [ "time"; "t" ] ~docv:"TIME" ~doc)

     

       81
       -
       

     

       82
       -
       let end_date_arg =

     

       83
       -
         let doc = "New event end date (YYYY-MM-DD)" in

     

       84
       -
         Arg.(

     

       85
       -
           value

     

       86
       -
           & opt (some string) None

     

       87
       -
           & info [ "end-date"; "e" ] ~docv:"END_DATE" ~doc)

     

       88
       -
       

     

       89
       -
       let end_time_arg =

     

       90
       -
         let doc = "New event end time (HH:MM)" in

     

       91
       -
         Arg.(

     

       92
       -
           value & opt (some string) None & info [ "end-time" ] ~docv:"END_TIME" ~doc)

     

       93
       -
       

     

       94
       -
       let location_arg =

     

       95
       -
         let doc = "New event location" in

     

       96
       -
         Arg.(

     

       97
       -
           value

     

       98
       -
           & opt (some string) None

     

       99
       -
           & info [ "location"; "l" ] ~docv:"LOCATION" ~doc)

     

       100
       -
       

     

       101
       -
       let description_arg =

     

       102
       -
         let doc = "New event description" in

     

       103
       -
         Arg.(

     

       104
       -
           value

     

       105
       -
           & opt (some string) None

     

       106
       -
           & info [ "description"; "D" ] ~docv:"DESCRIPTION" ~doc)

     

       107
       -
       

     

       108
       -
       let recur_arg =

     

       109
       -
         let doc =

     

       110
       -
           "Recurrence rule in iCalendar RFC5545 format. The FREQ part is required.\n\

     

       111
       -
           \    Use empty string to remove recurrence.\n\

     

       112
       -
           \    \n\

     

       113
       -
           \    FREQ=<frequency>: DAILY, WEEKLY, MONTHLY, or YEARLY (required)\n\

     

       114
       -
           \    COUNT=<number>: Limit to this many occurrences (optional, cannot be \

     

       115
       -
            used with UNTIL)\n\

     

       116
       -
           \    UNTIL=<date>: Repeat until this date (optional, cannot be used with \

     

       117
       -
            COUNT)\n\

     

       118
       -
           \    INTERVAL=<number>: Interval between occurrences, e.g., 2 for every \

     

       119
       -
            other (optional)\n\

     

       120
       -
           \    BYDAY=<dayspec>: Specific days, e.g., MO,WE,FR or 1MO (first Monday) \

     

       121
       -
            (optional)\n\

     

       122
       -
           \    BYMONTHDAY=<daynum>: Day of month, e.g., 1,15 or -1 (last day) \

     

       123
       -
            (optional)\n\

     

       124
       -
           \    BYMONTH=<monthnum>: Month number, e.g., 1,6,12 for Jan,Jun,Dec \

     

       125
       -
            (optional)\n\

     

       126
       -
           \    \n\

     

       127
       -
           \    Examples:\n\

     

       128
       -
           \    FREQ=DAILY;COUNT=5         - Daily for 5 occurrences\n\

     

       129
       -
           \    FREQ=WEEKLY;INTERVAL=2     - Every other week indefinitely\n\

     

       130
       -
           \    FREQ=WEEKLY;BYDAY=MO,WE,FR - Every Monday, Wednesday, Friday\n\

     

       131
       -
           \    FREQ=MONTHLY;BYDAY=1MO     - First Monday of every month\n\

     

       132
       -
           \    FREQ=YEARLY;BYMONTH=1;BYMONTHDAY=1 - Every January 1st (New Year's Day)\n\

     

       133
       -
           \    FREQ=MONTHLY;BYMONTHDAY=-1 - Last day of every month"

     

       134
       -
         in

     

       135
       -
         Arg.(

     

       136
       -
           value & opt (some string) None & info [ "recur"; "r" ] ~docv:"RECUR" ~doc)

     

       137
       -
       

     

       138
        
       let cmd ~fs calendar_dir =

     

       139
        
         let run event_id summary start_date start_time end_date end_time location

     

       140
       -
             description recur today tomorrow week month =

     

       141
        
           match

     

       142
        
             run ~event_id ~summary ~start_date ~start_time ~end_date ~end_time

     

       143
       -
               ~location ~description ~recur ~today ~tomorrow ~week ~month ~fs

     

       144
       -
               calendar_dir

     

       145
        
           with

     

       146
        
           | Error (`Msg msg) ->

     

       147
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       150
        
         in

     

       151
        
         let term =

     

       152
        
           Term.(

     

       153
       -
             const run $ event_id_arg $ summary_arg $ start_date_arg $ start_time_arg

     

       154
       -
             $ end_date_arg $ end_time_arg $ location_arg $ description_arg $ recur_arg

     

       155
       -
             $ today_arg $ tomorrow_arg $ week_arg $ month_arg)

     

       156
        
         in

     

       157
        
         let doc = "Edit an existing calendar event" in

     

       158
        
         let man =

     
···

       162
        
             `P

     

       163
        
               "Specify the event ID as the first argument, and use options to change \

     

       164
        
                event details.";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       165
        
             `S Manpage.s_options;

     

       166
        
           ]

     

       167
       -
           @ date_format_manpage_entries

     

       168
       -
           @ [

     

       169
       -
               `S Manpage.s_examples;

     

       170
       -
               `I

     

       171
       -
                 ( "Change the summary of an event:",

     

       172
       -
                   "caled edit 12345678-1234-5678-1234-567812345678 --summary \"New \

     

       173
       -
                    Title\"" );

     

       174
       -
               `I

     

       175
       -
                 ( "Change the date and time:",

     

       176
       -
                   "caled edit 12345678-1234-5678-1234-567812345678 --date 2025-05-01 \

     

       177
       -
                    --time 15:30" );

     

       178
       -
               `I

     

       179
       -
                 ( "Update the location:",

     

       180
       -
                   "caled edit 12345678-1234-5678-1234-567812345678 --location \

     

       181
       -
                    \"Conference Room B\"" );

     

       182
       -
               `I

     

       183
       -
                 ( "Change the description:",

     

       184
       -
                   "caled edit 12345678-1234-5678-1234-567812345678 --description \

     

       185
       -
                    \"Updated agenda for the meeting\"" );

     

       186
       -
             ]

     

       187
        
         in

     

       188
       -
         let info = Cmd.info "edit" ~doc ~man in

     

       189
        
         Cmd.v info term

···

       1
        
       open Cmdliner

     

       2
        
       open Caledonia_lib

     

       3
       +
       open Event_args

     

       4
        
       

     

       5
        
       let run ~event_id ~summary ~start_date ~start_time ~end_date ~end_time ~location

     

       6
       +
           ~description ~recur ?timezone ?end_timezone ~fs calendar_dir =

     

       7
        
         let ( let* ) = Result.bind in

     

       8
       +
         let filter = Event.with_id event_id in

     

       9
       +
         let* events = Calendar_dir.get_events ~fs calendar_dir in

     

       10
       +
         let results = Event.query_without_recurrence events ~filter () in

     

       11
        
         let* event =

     

       12
        
           match results with

     

       13
        
           | [ event ] -> Ok event

     

       14
        
           | [] -> Error (`Msg ("No events found found for id " ^ event_id))

     

       15
        
           | _ -> Error (`Msg ("More than one found for id " ^ event_id))

     

       16
        
         in

     

       17
       +
         let* start = parse_start ~start_date ~start_time ~timezone in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       18
        
         let* end_ =

     

       19
       +
           let end_date =

     

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

     

       21
       +
             match (end_date, end_time) with

     

       22
       +
             | None, Some _ -> start_date

     

       23
       +
             | _ -> end_date

     

       24
       +
           in

     

       25
       +
           let end_timezone =

     

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

     

       27
       +
             match (end_date, end_time, end_timezone) with

     

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

     

       29
       +
             | _ -> end_timezone

     

       30
       +
           in

     

       31
       +
           parse_end ~end_date ~end_time ~end_timezone

     

       32
        
         in

     

       33
        
         let* recurrence =

     

       34
        
           match recur with

     

       35
        
           | Some r ->

     

       36
       +
               let* p = parse_recurrence r in

     

       37
        
               Ok (Some p)

     

       38
        
           | None -> Ok None

     

       39
        
         in

     

       40
       +
         let* modifed_event =

     

       41
        
           Event.edit ?summary ?start ?end_ ?location ?description ?recurrence event

     

       42
        
         in

     

       43
       +
         let* _ = Calendar_dir.edit_event ~fs calendar_dir events modifed_event in

     

       44
        
         Printf.printf "Event %s updated.\n" event_id;

     

       45
        
         Ok ()

     

       46
        
       

     
···

       48
        
         let doc = "ID of the event to edit" in

     

       49
        
         Arg.(required & pos 0 (some string) None & info [] ~docv:"EVENT_ID" ~doc)

     

       50
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       51
        
       let cmd ~fs calendar_dir =

     

       52
        
         let run event_id summary start_date start_time end_date end_time location

     

       53
       +
             description recur timezone end_timezone () =

     

       54
        
           match

     

       55
        
             run ~event_id ~summary ~start_date ~start_time ~end_date ~end_time

     

       56
       +
               ~location ~description ~recur ?timezone ?end_timezone ~fs calendar_dir

     

       0
        
       
     

       57
        
           with

     

       58
        
           | Error (`Msg msg) ->

     

       59
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       62
        
         in

     

       63
        
         let term =

     

       64
        
           Term.(

     

       65
       +
             const run $ event_id_arg $ optional_summary_arg $ start_date_arg

     

       66
       +
             $ start_time_arg $ end_date_arg $ end_time_arg $ location_arg

     

       67
       +
             $ description_arg $ recur_arg $ timezone_arg $ end_timezone_arg)

     

       68
        
         in

     

       69
        
         let doc = "Edit an existing calendar event" in

     

       70
        
         let man =

     
···

       74
        
             `P

     

       75
        
               "Specify the event ID as the first argument, and use options to change \

     

       76
        
                event details.";

     

       77
       +
             `S Manpage.s_examples;

     

       78
       +
             `I

     

       79
       +
               ( "Change the summary of an event:",

     

       80
       +
                 "caled edit 12345678-1234-5678-1234-567812345678 --summary \"New \

     

       81
       +
                  Title\"" );

     

       82
       +
             `I

     

       83
       +
               ( "Change the date and time:",

     

       84
       +
                 "caled edit 12345678-1234-5678-1234-567812345678 --date 2025-05-01 \

     

       85
       +
                  --time 15:30" );

     

       86
       +
             `I

     

       87
       +
               ( "Update the location:",

     

       88
       +
                 "caled edit 12345678-1234-5678-1234-567812345678 --location \

     

       89
       +
                  \"Conference Room B\"" );

     

       90
       +
             `I

     

       91
       +
               ( "Change the description:",

     

       92
       +
                 "caled edit 12345678-1234-5678-1234-567812345678 --description \

     

       93
       +
                  \"Updated agenda for the meeting\"" );

     

       94
        
             `S Manpage.s_options;

     

       95
        
           ]

     

       96
       +
           @ date_format_manpage_entries @ recurrence_format_manpage_entries

     

       97
       +
           @ [ `S Manpage.s_see_also ]

     

       98
       +
         in

     

       99
       +
         let exit_info =

     

       100
       +
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       101
        
         in

     

       102
       +
         let info = Cmd.info "edit" ~doc ~man ~exits:exit_info in

     

       103
        
         Cmd.v info term

+434

bin/event_args.ml

···

       1
       +
       open Cmdliner

     

       2
       +
       open Caledonia_lib

     

       3
       +
       

     

       4
       +
       let calendar_name_arg =

     

       5
       +
         let doc = "Calendar to add the event to" in

     

       6
       +
         Arg.(

     

       7
       +
           required

     

       8
       +
           & opt (some string) None

     

       9
       +
           & info [ "calendar"; "c" ] ~docv:"CALENDAR" ~doc)

     

       10
       +
       

     

       11
       +
       let required_summary_arg =

     

       12
       +
         let doc = "Event summary/title" in

     

       13
       +
         Arg.(required & pos 0 (some string) None & info [] ~docv:"SUMMARY" ~doc)

     

       14
       +
       

     

       15
       +
       let optional_summary_arg =

     

       16
       +
         let doc = "Event summary/title" in

     

       17
       +
         Arg.(

     

       18
       +
           value

     

       19
       +
           & opt (some string) None

     

       20
       +
           & info [ "summary"; "s" ] ~docv:"SUMMARY" ~doc)

     

       21
       +
       

     

       22
       +
       let start_date_arg =

     

       23
       +
         let doc = "Event start date (YYYY-MM-DD)" in

     

       24
       +
         Arg.(value & opt (some string) None & info [ "date"; "d" ] ~docv:"DATE" ~doc)

     

       25
       +
       

     

       26
       +
       let start_time_arg =

     

       27
       +
         let doc = "Event start time (HH:MM)" in

     

       28
       +
         Arg.(value & opt (some string) None & info [ "time"; "t" ] ~docv:"TIME" ~doc)

     

       29
       +
       

     

       30
       +
       let end_date_arg =

     

       31
       +
         let doc = "Event end date (YYYY-MM-DD). Defaults to DATE." in

     

       32
       +
         Arg.(

     

       33
       +
           value

     

       34
       +
           & opt (some string) None

     

       35
       +
           & info [ "end-date"; "e" ] ~docv:"END_DATE" ~doc)

     

       36
       +
       

     

       37
       +
       let end_time_arg =

     

       38
       +
         let doc = "Event end time (HH:MM)" in

     

       39
       +
         Arg.(

     

       40
       +
           value

     

       41
       +
           & opt (some string) None

     

       42
       +
           & info [ "end-time"; "T" ] ~docv:"END_TIME" ~doc)

     

       43
       +
       

     

       44
       +
       let timezone_arg =

     

       45
       +
         let doc =

     

       46
       +
           "Timezone to add events to (e.g., 'America/New_York', 'UTC', \

     

       47
       +
            'Europe/London'). If not specified, will use the local timezone. For a \

     

       48
       +
            floating time (always at whatever the sytem time is), use 'FLOATING'."

     

       49
       +
         in

     

       50
       +
         Arg.(

     

       51
       +
           value

     

       52
       +
           & opt (some string) None

     

       53
       +
           & info [ "timezone"; "z" ] ~docv:"TIMEZONE" ~doc)

     

       54
       +
       

     

       55
       +
       let end_timezone_arg =

     

       56
       +
         let doc = "The timezone of the end of the event. Defaults to TIMEZONE." in

     

       57
       +
         Arg.(

     

       58
       +
           value

     

       59
       +
           & opt (some string) None

     

       60
       +
           & info [ "end-timezone"; "Z" ] ~docv:"END_TIMEZONE" ~doc)

     

       61
       +
       

     

       62
       +
       let location_arg =

     

       63
       +
         let doc = "Event location" in

     

       64
       +
         Arg.(

     

       65
       +
           value

     

       66
       +
           & opt (some string) None

     

       67
       +
           & info [ "location"; "l" ] ~docv:"LOCATION" ~doc)

     

       68
       +
       

     

       69
       +
       let description_arg =

     

       70
       +
         let doc = "Event description" in

     

       71
       +
         Arg.(

     

       72
       +
           value

     

       73
       +
           & opt (some string) None

     

       74
       +
           & info [ "description"; "D" ] ~docv:"DESCRIPTION" ~doc)

     

       75
       +
       

     

       76
       +
       let recur_arg =

     

       77
       +
         let doc = "See RECURRENCE section" in

     

       78
       +
         Arg.(

     

       79
       +
           value & opt (some string) None & info [ "recur"; "r" ] ~docv:"RECUR" ~doc)

     

       80
       +
       

     

       81
       +
       let date_format_manpage_entries =

     

       82
       +
         [

     

       83
       +
           `S "DATE FORMATS";

     

       84
       +
           `P

     

       85
       +
             "The following are the possible date formats for the --date and \

     

       86
       +
              --end-date command line parameters. Note the value is dependent on \

     

       87
       +
              --date / --end-date, so --date 2025-03 --end-date 2025-03 will span the \

     

       88
       +
              month of March.";

     

       89
       +
           `I ("YYYY-MM-DD", "Specific date (e.g., 2025-3-27, zero-padding optional)");

     

       90
       +
           `I ("YYYY-MM", "Start/end of specific month (e.g., 2025-3 for March 2025)");

     

       91
       +
           `I ("YYYY", "Start/end of specific year (e.g., 2025)");

     

       92
       +
           `I ("today", "Current day");

     

       93
       +
           `I ("tomorrow", "Next day");

     

       94
       +
           `I ("yesterday", "Previous day");

     

       95
       +
           `I ("this-week", "Start/end of current week");

     

       96
       +
           `I ("next-week", "Start/end of next week");

     

       97
       +
           `I ("this-month", "Start/end of current month");

     

       98
       +
           `I ("next-month", "Start/end of next month");

     

       99
       +
           `I ("+Nd", "N days from today (e.g., +7d for a week from today)");

     

       100
       +
           `I ("-Nd", "N days before today (e.g., -7d for a week ago)");

     

       101
       +
           `I ("+Nw", "N weeks from today (e.g., +4w for 4 weeks from today)");

     

       102
       +
           `I ("+Nm", "N months from today (e.g., +2m for 2 months from today)");

     

       103
       +
         ]

     

       104
       +
       

     

       105
       +
       let parse_start ~start_date ~start_time ~timezone =

     

       106
       +
         let ( let* ) = Result.bind in

     

       107
       +
         let* _ =

     

       108
       +
           match timezone with

     

       109
       +
           | None -> Ok ()

     

       110
       +
           | Some tzid -> (

     

       111
       +
               match Timedesc.Time_zone.make tzid with

     

       112
       +
               | Some _ -> Ok ()

     

       113
       +
               | None ->

     

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

     

       115
       +
         in

     

       116
       +
         match start_date with

     

       117
       +
         | None ->

     

       118
       +
             let* _ =

     

       119
       +
               match start_time with

     

       120
       +
               | None -> Ok ()

     

       121
       +
               | Some _ ->

     

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

     

       123
       +
             in

     

       124
       +
             let* _ =

     

       125
       +
               match timezone with

     

       126
       +
               | None -> Ok ()

     

       127
       +
               | _ -> Error (`Msg "Can't specify a timezone without a start date")

     

       128
       +
             in

     

       129
       +
             Ok None

     

       130
       +
         | Some start_date -> (

     

       131
       +
             match start_time with

     

       132
       +
             | None ->

     

       133
       +
                 let* _ =

     

       134
       +
                   match timezone with

     

       135
       +
                   | None -> Ok ()

     

       136
       +
                   | _ -> Error (`Msg "Can't specify a timezone without a start time")

     

       137
       +
                 in

     

       138
       +
                 let* ptime =

     

       139
       +
                   Date.parse_date ~tz:Timedesc.Time_zone.utc start_date `From

     

       140
       +
                 in

     

       141
       +
                 let date = Ptime.to_date ptime in

     

       142
       +
                 Ok (Some (Icalendar.Params.singleton Valuetype `Date, `Date date))

     

       143
       +
             | Some start_time -> (

     

       144
       +
                 match timezone with

     

       145
       +
                 | None ->

     

       146
       +
                     let* tzid =

     

       147
       +
                       match Timedesc.Time_zone.local () with

     

       148
       +
                       | Some tz -> Ok (Timedesc.Time_zone.name tz)

     

       149
       +
                       | None -> Error (`Msg "Failed to get system timezone")

     

       150
       +
                     in

     

       151
       +
                     let* datetime =

     

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

     

       153
       +
                         ~time:start_time `From

     

       154
       +
                     in

     

       155
       +
                     Ok

     

       156
       +
                       (Some

     

       157
       +
                          ( Icalendar.Params.empty,

     

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

     

       159
       +
                 | Some "FLOATING" ->

     

       160
       +
                     let* datetime =

     

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

     

       162
       +
                         ~time:start_time `From

     

       163
       +
                     in

     

       164
       +
                     Ok (Some (Icalendar.Params.empty, `Datetime (`Local datetime)))

     

       165
       +
                 | Some "UTC" ->

     

       166
       +
                     let* datetime =

     

       167
       +
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date

     

       168
       +
                         ~time:start_time `From

     

       169
       +
                     in

     

       170
       +
                     Ok (Some (Icalendar.Params.empty, `Datetime (`Utc datetime)))

     

       171
       +
                 | Some tzid ->

     

       172
       +
                     let* datetime =

     

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

     

       174
       +
                         ~time:start_time `From

     

       175
       +
                     in

     

       176
       +
                     Ok

     

       177
       +
                       (Some

     

       178
       +
                          ( Icalendar.Params.empty,

     

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

     

       180
       +
       

     

       181
       +
       let parse_end ~end_date ~end_time ~end_timezone =

     

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

     

       183
       +
         let* _ =

     

       184
       +
           match end_timezone with

     

       185
       +
           | None -> Ok ()

     

       186
       +
           | Some tzid -> (

     

       187
       +
               match Timedesc.Time_zone.make tzid with

     

       188
       +
               | Some _ -> Ok ()

     

       189
       +
               | None ->

     

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

     

       191
       +
         in

     

       192
       +
         match end_date with

     

       193
       +
         | None ->

     

       194
       +
             let* _ =

     

       195
       +
               match end_time with

     

       196
       +
               | None -> Ok ()

     

       197
       +
               | Some _ -> Error (`Msg "Can't specify an end time without an end date")

     

       198
       +
             in

     

       199
       +
             let* _ =

     

       200
       +
               match end_timezone with

     

       201
       +
               | None -> Ok ()

     

       202
       +
               | Some _ ->

     

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

     

       204
       +
             in

     

       205
       +
             Ok None

     

       206
       +
         | Some end_date -> (

     

       207
       +
             match end_time with

     

       208
       +
             | None ->

     

       209
       +
                 let* _ =

     

       210
       +
                   match end_timezone with

     

       211
       +
                   | Some _ ->

     

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

     

       213
       +
                   | _ -> Ok ()

     

       214
       +
                 in

     

       215
       +
                 let* ptime =

     

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

     

       217
       +
                 in

     

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

     

       219
       +
                 let ptime = Date.add_days ptime 1 in

     

       220
       +
                 let date = Ptime.to_date ptime in

     

       221
       +
                 Ok

     

       222
       +
                   (Some

     

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

     

       224
       +
             | Some end_time -> (

     

       225
       +
                 match end_timezone with

     

       226
       +
                 | None ->

     

       227
       +
                     let* tzid =

     

       228
       +
                       match Timedesc.Time_zone.local () with

     

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

     

       230
       +
                       | None -> Error (`Msg "Failed to get system timezone")

     

       231
       +
                     in

     

       232
       +
                     let* datetime =

     

       233
       +
                       Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date

     

       234
       +
                         ~time:end_time `From

     

       235
       +
                     in

     

       236
       +
                     Ok

     

       237
       +
                       (Some

     

       238
       +
                          (`Dtend

     

       239
       +
                             ( Icalendar.Params.empty,

     

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

     

       241
       +
                 | Some "FLOATING" ->

     

       242
       +
                     let* datetime =

     

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

     

       244
       +
                         ~time:end_time `From

     

       245
       +
                     in

     

       246
       +
                     Ok

     

       247
       +
                       (Some

     

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

     

       249
       +
                 | Some "UTC" ->

     

       250
       +
                     let* datetime =

     

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

     

       252
       +
                         ~time:end_time `From

     

       253
       +
                     in

     

       254
       +
                     Ok

     

       255
       +
                       (Some

     

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

     

       257
       +
                 | Some tzid ->

     

       258
       +
                     let* datetime =

     

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

     

       260
       +
                         ~time:end_time `From

     

       261
       +
                     in

     

       262
       +
                     Ok

     

       263
       +
                       (Some

     

       264
       +
                          (`Dtend

     

       265
       +
                             ( Icalendar.Params.empty,

     

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

     

       267
       +
       

     

       268
       +
       let combine_results (results : ('a, 'b) result list) : ('a list, 'b) result =

     

       269
       +
         let rec aux acc = function

     

       270
       +
           | [] -> Ok (List.rev acc)

     

       271
       +
           | Ok v :: rest -> aux (v :: acc) rest

     

       272
       +
           | Error e :: _ -> Error e

     

       273
       +
         in

     

       274
       +
         aux [] results

     

       275
       +
       

     

       276
       +
       let parse_recurrence recur =

     

       277
       +
         let ( let* ) = Result.bind in

     

       278
       +
         let parts = String.split_on_char ';' recur in

     

       279
       +
         let freq = ref None in

     

       280
       +
         let count = ref None in

     

       281
       +
         let until = ref None in

     

       282
       +
         let interval = ref None in

     

       283
       +
         let by_parts = ref [] in

     

       284
       +
         let results =

     

       285
       +
           List.map

     

       286
       +
             (fun part ->

     

       287
       +
               let kv = String.split_on_char '=' part in

     

       288
       +
               match kv with

     

       289
       +
               | [ "FREQ"; value ] -> (

     

       290
       +
                   match String.uppercase_ascii value with

     

       291
       +
                   | "DAILY" ->

     

       292
       +
                       freq := Some `Daily;

     

       293
       +
                       Ok ()

     

       294
       +
                   | "WEEKLY" ->

     

       295
       +
                       freq := Some `Weekly;

     

       296
       +
                       Ok ()

     

       297
       +
                   | "MONTHLY" ->

     

       298
       +
                       freq := Some `Monthly;

     

       299
       +
                       Ok ()

     

       300
       +
                   | "YEARLY" ->

     

       301
       +
                       freq := Some `Yearly;

     

       302
       +
                       Ok ()

     

       303
       +
                   | _ -> Error (`Msg ("Unsupported frequency: " ^ value)))

     

       304
       +
               | [ "COUNT"; value ] ->

     

       305
       +
                   if !until <> None then

     

       306
       +
                     Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")

     

       307
       +
                   else (

     

       308
       +
                     count := Some (`Count (int_of_string value));

     

       309
       +
                     Ok ())

     

       310
       +
               | [ "UNTIL"; value ] -> (

     

       311
       +
                   if !count <> None then

     

       312
       +
                     Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")

     

       313
       +
                   else

     

       314
       +
                     let* v =

     

       315
       +
                       match Icalendar.parse_datetime value with

     

       316
       +
                       | Ok v -> Ok v

     

       317
       +
                       | Error e -> Error (`Msg e)

     

       318
       +
                     in

     

       319
       +
                     match v with

     

       320
       +
                     | `With_tzid _ -> Error (`Msg "Until can't be in a timezone")

     

       321
       +
                     | `Utc u ->

     

       322
       +
                         until := Some (`Until (`Utc u));

     

       323
       +
                         Ok ()

     

       324
       +
                     | `Local l ->

     

       325
       +
                         until := Some (`Until (`Local l));

     

       326
       +
                         Ok ())

     

       327
       +
               | [ "INTERVAL"; value ] ->

     

       328
       +
                   interval := Some (int_of_string value);

     

       329
       +
                   Ok ()

     

       330
       +
               | [ "BYDAY"; value ] ->

     

       331
       +
                   (* Parse day specifications like MO,WE,FR or 1MO,-1FR *)

     

       332
       +
                   let days = String.split_on_char ',' value in

     

       333
       +
                   let parse_day day =

     

       334
       +
                     (* Extract ordinal if present (like 1MO or -1FR) *)

     

       335
       +
                     let ordinal, day_code =

     

       336
       +
                       if

     

       337
       +
                         String.length day >= 3

     

       338
       +
                         && (String.get day 0 = '+'

     

       339
       +
                            || String.get day 0 = '-'

     

       340
       +
                            || (String.get day 0 >= '0' && String.get day 0 <= '9'))

     

       341
       +
                       then (

     

       342
       +
                         let idx = ref 0 in

     

       343
       +
                         while

     

       344
       +
                           !idx < String.length day

     

       345
       +
                           && (String.get day !idx = '+'

     

       346
       +
                              || String.get day !idx = '-'

     

       347
       +
                              || String.get day !idx >= '0'

     

       348
       +
                                 && String.get day !idx <= '9')

     

       349
       +
                         do

     

       350
       +
                           incr idx

     

       351
       +
                         done;

     

       352
       +
                         let ord_str = String.sub day 0 !idx in

     

       353
       +
                         let day_str =

     

       354
       +
                           String.sub day !idx (String.length day - !idx)

     

       355
       +
                         in

     

       356
       +
                         (int_of_string ord_str, day_str))

     

       357
       +
                       else (0, day)

     

       358
       +
                     in

     

       359
       +
                     let* weekday =

     

       360
       +
                       match day_code with

     

       361
       +
                       | "MO" -> Ok `Monday

     

       362
       +
                       | "TU" -> Ok `Tuesday

     

       363
       +
                       | "WE" -> Ok `Wednesday

     

       364
       +
                       | "TH" -> Ok `Thursday

     

       365
       +
                       | "FR" -> Ok `Friday

     

       366
       +
                       | "SA" -> Ok `Saturday

     

       367
       +
                       | "SU" -> Ok `Sunday

     

       368
       +
                       | _ -> Error (`Msg ("Invalid weekday: " ^ day_code))

     

       369
       +
                     in

     

       370
       +
                     Ok (ordinal, weekday)

     

       371
       +
                   in

     

       372
       +
                   let* day_specs = combine_results (List.map parse_day days) in

     

       373
       +
                   by_parts := `Byday day_specs :: !by_parts;

     

       374
       +
                   Ok ()

     

       375
       +
               | [ "BYMONTHDAY"; value ] ->

     

       376
       +
                   let days = String.split_on_char ',' value in

     

       377
       +
                   let month_days = List.map int_of_string days in

     

       378
       +
                   by_parts := `Bymonthday month_days :: !by_parts;

     

       379
       +
                   Ok ()

     

       380
       +
               | [ "BYMONTH"; value ] ->

     

       381
       +
                   let months = String.split_on_char ',' value in

     

       382
       +
                   let month_nums = List.map int_of_string months in

     

       383
       +
                   by_parts := `Bymonth month_nums :: !by_parts;

     

       384
       +
                   Ok ()

     

       385
       +
               | _ -> Ok ())

     

       386
       +
             parts

     

       387
       +
         in

     

       388
       +
         let* _ = combine_results results in

     

       389
       +
         match !freq with

     

       390
       +
         | Some f ->

     

       391
       +
             let limit =

     

       392
       +
               match (!count, !until) with

     

       393
       +
               | Some c, None -> Some c

     

       394
       +
               | None, Some u -> Some u

     

       395
       +
               | _ -> None

     

       396
       +
             in

     

       397
       +
             let recurrence = (f, limit, !interval, !by_parts) in

     

       398
       +
             Ok recurrence

     

       399
       +
         | None -> Error (`Msg "FREQ is required in recurrence rule")

     

       400
       +
       

     

       401
       +
       let recurrence_format_manpage_entries =

     

       402
       +
         [

     

       403
       +
           `S "RECURRENCE";

     

       404
       +
           `P "Recurrence rule in iCalendar RFC5545 format. The FREQ part is required.";

     

       405
       +
           `I ("FREQ=<frequency>", "DAILY, WEEKLY, MONTHLY, or YEARLY (required)");

     

       406
       +
           `I

     

       407
       +
             ( "COUNT=<number>",

     

       408
       +
               "Limit to this many occurrences (optional, cannot be used with UNTIL)"

     

       409
       +
             );

     

       410
       +
           `I

     

       411
       +
             ( "UNTIL=<date>",

     

       412
       +
               "Repeat until this date (optional, cannot be used with COUNT)" );

     

       413
       +
           `I

     

       414
       +
             ( "INTERVAL=<number>",

     

       415
       +
               "Interval between occurrences, e.g., 2 for every other (optional)" );

     

       416
       +
           `I

     

       417
       +
             ( "BYDAY=<dayspec>",

     

       418
       +
               "Specific days, e.g., MO,WE,FR or 1MO (first Monday) (optional)" );

     

       419
       +
           `I

     

       420
       +
             ( "BYMONTHDAY=<daynum>",

     

       421
       +
               "Day of month, e.g., 1,15 or -1 (last day) (optional)" );

     

       422
       +
           `I

     

       423
       +
             ( "BYMONTH=<monthnum>",

     

       424
       +
               "Month number, e.g., 1,6,12 for Jan,Jun,Dec (optional)" );

     

       425
       +
           `P "Examples:";

     

       426
       +
           `I ("FREQ=DAILY;COUNT=5", "Daily for 5 occurrences");

     

       427
       +
           `I ("FREQ=WEEKLY;INTERVAL=2", "Every other week indefinitely");

     

       428
       +
           `I ("FREQ=WEEKLY;BYDAY=MO,WE,FR", "Every Monday, Wednesday, Friday");

     

       429
       +
           `I ("FREQ=MONTHLY;BYDAY=1MO", "First Monday of every month");

     

       430
       +
           `I

     

       431
       +
             ( "FREQ=YEARLY;BYMONTH=1;BYMONTHDAY=1",

     

       432
       +
               "Every January 1st (New Year's Day)" );

     

       433
       +
           `I ("FREQ=MONTHLY;BYMONTHDAY=-1", "Last day of every month");

     

       434
       +
         ]

+75 -42

bin/list_cmd.ml

···

       2
        
       open Caledonia_lib

     

       3
        
       open Query_args

     

       4
        
       

     

       5
       -
       let run ?from ?to_ ?calendar ?count ~format ~today ~tomorrow ~week ~month ~fs

     

       6
       -
           calendar_dir =

     

       7
        
         let ( let* ) = Result.bind in

     

       8
       -
         let from, to_ =

     

       9
       -
           match Date.convert_relative_date_formats ~today ~tomorrow ~week ~month with

     

       10
       -
           | Some (from, to_) -> (Some from, to_)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       11
        
           | None -> (

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       12
        
               match (from, to_) with

     

       13
       -
               | Some f, Some t -> (Some f, Date.to_end_of_day t)

     

       14
        
               | Some f, None ->

     

       15
        
                   let one_month_later = Date.add_months f 1 in

     

       16
       -
                   (Some f, one_month_later)

     

       17
       -
               | None, Some t ->

     

       18
       -
                   let today_date = !Date.get_today () in

     

       19
       -
                   (Some today_date, Date.to_end_of_day t)

     

       20
        
               | None, None ->

     

       21
       -
                   let today_date = !Date.get_today () in

     

       22
        
                   let one_month_later = Date.add_months today_date 1 in

     

       23
       -
                   (Some today_date, one_month_later))

     

       24
        
         in

     

       25
        
         let filter =

     

       26
       -
           match calendar with

     

       27
       -
           | Some collection_id ->

     

       28
       -
               Some (Query.in_collections [ Collection.Col collection_id ])

     

       29
       -
           | None -> None

     

       30
        
         in

     

       31
       -
         let* results =

     

       32
       -
           Query.query ~fs calendar_dir ?filter ~from ~to_ ?limit:count ()

     

       0
        
       
     

       0
        
       
     

       33
        
         in

     

       34
       -
         if results = [] then print_endline "No events found."

     

       35
       -
         else print_endline (Format.format_instances ~format results);

     

       36
        
         Ok ()

     

       37
        
       

     

       38
        
       let cmd ~fs calendar_dir =

     

       39
       -
         let run from to_ calendar count format today tomorrow week month =

     

       0
        
       
     

       40
        
           match

     

       41
       -
             run ?from ?to_ ?calendar ?count ~format ~today ~tomorrow ~week ~month ~fs

     

       42
       -
               calendar_dir

     

       43
        
           with

     

       44
        
           | Error (`Msg msg) ->

     

       45
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       49
        
         let term =

     

       50
        
           Term.(

     

       51
        
             const run $ from_arg $ to_arg $ calendar_arg $ count_arg $ format_arg

     

       52
       -
             $ today_arg $ tomorrow_arg $ week_arg $ month_arg)

     

       0
        
       
     

       53
        
         in

     

       54
        
         let doc = "List calendar events" in

     

       55
        
         let man =

     

       56
        
           [

     

       57
        
             `S Manpage.s_description;

     

       58
       -
             `P "List calendar events within a specified date range.";

     

       59
       -
             `P "By default, events from today to one month from today are shown.";

     

       60
       -
             `P "You can use date flags to show events for a specific time period.";

     

       61
       -
             `P "You can also filter events by calendar using the --calendar flag.";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       62
        
             `S Manpage.s_options;

     

       63
        
           ]

     

       64
        
           @ date_format_manpage_entries

     

       65
       -
           @ [

     

       66
       -
               `S Manpage.s_examples;

     

       67
       -
               `I ("List all events for today:", "caled list --today");

     

       68
       -
               `I ("List all events for tomorrow:", "caled list --tomorrow");

     

       69
       -
               `I ("List all events for the current week:", "caled list --week");

     

       70
       -
               `I ("List all events for the current month:", "caled list --month");

     

       71
       -
               `I

     

       72
       -
                 ( "List events within a specific date range:",

     

       73
       -
                   "caled list --from 2025-03-27 --to 2025-04-01" );

     

       74
       -
               `I

     

       75
       -
                 ("List events from a specific calendar:", "caled list --calendar work");

     

       76
       -
               `I ("List events in JSON format:", "caled list --format json");

     

       77
       -
               `I ("Limit the number of events shown:", "caled list --count 5");

     

       78
       -
             ]

     

       79
        
         in

     

       80
        
         let exit_info =

     

       81
        
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

···

       2
        
       open Caledonia_lib

     

       3
        
       open Query_args

     

       4
        
       

     

       5
       +
       let run ?from_str ?to_str ~calendar:calendars ?count ~format ~today ~tomorrow

     

       6
       +
           ~week ~month ?timezone ~sort ~fs calendar_dir =

     

       7
        
         let ( let* ) = Result.bind in

     

       8
       +
         let tz = Query_args.parse_timezone ~timezone in

     

       9
       +
         let* from, to_ =

     

       10
       +
           match

     

       11
       +
             Date.convert_relative_date_formats ~tz ~today ~tomorrow ~week ~month ()

     

       12
       +
           with

     

       13
       +
           | Some (from, to_) ->

     

       14
       +
               let* _ =

     

       15
       +
                 match (from_str, to_str) with

     

       16
       +
                 | None, None -> Ok ()

     

       17
       +
                 | _ ->

     

       18
       +
                     Error

     

       19
       +
                       (`Msg

     

       20
       +
                          "Can't specify --from / --to when using --today, --week, \

     

       21
       +
                           --month")

     

       22
       +
               in

     

       23
       +
               Ok (Some from, to_)

     

       24
        
           | None -> (

     

       25
       +
               let* from =

     

       26
       +
                 match from_str with

     

       27
       +
                 | None -> Ok None

     

       28
       +
                 | Some s ->

     

       29
       +
                     let* d = Date.parse_date ~tz s `From in

     

       30
       +
                     Ok (Some d)

     

       31
       +
               in

     

       32
       +
               let* to_ =

     

       33
       +
                 match to_str with

     

       34
       +
                 | None -> Ok None

     

       35
       +
                 | Some s ->

     

       36
       +
                     let* d = Date.parse_date ~tz s `To in

     

       37
       +
                     Ok (Some d)

     

       38
       +
               in

     

       39
        
               match (from, to_) with

     

       40
       +
               | Some f, Some t -> Ok (Some f, Date.to_end_of_day t)

     

       41
        
               | Some f, None ->

     

       42
        
                   let one_month_later = Date.add_months f 1 in

     

       43
       +
                   Ok (Some f, one_month_later)

     

       44
       +
               | None, Some t -> Ok (None, Date.to_end_of_day t)

     

       0
        
       
     

       0
        
       
     

       45
        
               | None, None ->

     

       46
       +
                   let today_date = !Date.get_today ~tz () in

     

       47
        
                   let one_month_later = Date.add_months today_date 1 in

     

       48
       +
                   Ok (Some today_date, one_month_later))

     

       49
        
         in

     

       50
        
         let filter =

     

       51
       +
           match calendars with

     

       52
       +
           | [] -> None

     

       53
       +
           | calendar -> Some (Event.in_calendars calendar)

     

       0
        
       
     

       54
        
         in

     

       55
       +
         let comparator = Query_args.create_event_comparator sort in

     

       56
       +
         let* events = Calendar_dir.get_events ~fs calendar_dir in

     

       57
       +
         let events =

     

       58
       +
           Event.query events ?filter ~from ~to_ ~comparator ?limit:count ()

     

       59
        
         in

     

       60
       +
         if events = [] then print_endline "No events found."

     

       61
       +
         else print_endline (Event.format_events ~format ~tz events);

     

       62
        
         Ok ()

     

       63
        
       

     

       64
        
       let cmd ~fs calendar_dir =

     

       65
       +
         let run from_str to_str calendars count format today tomorrow week month

     

       66
       +
             timezone sort () =

     

       67
        
           match

     

       68
       +
             run ?from_str ?to_str ~calendar:calendars ?count ~format ~today ~tomorrow

     

       69
       +
               ~week ~month ?timezone ~sort ~fs calendar_dir

     

       70
        
           with

     

       71
        
           | Error (`Msg msg) ->

     

       72
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       76
        
         let term =

     

       77
        
           Term.(

     

       78
        
             const run $ from_arg $ to_arg $ calendar_arg $ count_arg $ format_arg

     

       79
       +
             $ today_arg $ tomorrow_arg $ week_arg $ month_arg $ timezone_arg

     

       80
       +
             $ sort_arg)

     

       81
        
         in

     

       82
        
         let doc = "List calendar events" in

     

       83
        
         let man =

     

       84
        
           [

     

       85
        
             `S Manpage.s_description;

     

       86
       +
             `P

     

       87
       +
               "List calendar events within a specified date range. By default, \

     

       88
       +
                events from today to one month from today are shown. You can use date \

     

       89
       +
                flags to show events for a specific time period, and filter events \

     

       90
       +
                with the --sort option.";

     

       91
       +
             `S Manpage.s_examples;

     

       92
       +
             `I ("List all events for today:", "caled list --today");

     

       93
       +
             `I ("List all events for tomorrow:", "caled list --tomorrow");

     

       94
       +
             `I ("List all events for the current week:", "caled list --week");

     

       95
       +
             `I ("List all events for the current month:", "caled list --month");

     

       96
       +
             `I

     

       97
       +
               ( "List events within a specific date range:",

     

       98
       +
                 "caled list --from 2025-03-27 --to 2025-04-01" );

     

       99
       +
             `I ("List events from a specific calendar:", "caled list --calendar work");

     

       100
       +
             `I ("List events in JSON format:", "caled list --format json");

     

       101
       +
             `I ("Limit the number of events shown:", "caled list --count 5");

     

       102
       +
             `I

     

       103
       +
               ( "Sort by multiple fields (start time and summary):",

     

       104
       +
                 "caled list --sort start --sort summary" );

     

       105
       +
             `I

     

       106
       +
               ( "Sort by calendar name in descending order:",

     

       107
       +
                 "caled list --sort calendar:desc" );

     

       108
        
             `S Manpage.s_options;

     

       109
        
           ]

     

       110
        
           @ date_format_manpage_entries

     

       111
       +
           @ [ `S Manpage.s_see_also ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       112
        
         in

     

       113
        
         let exit_info =

     

       114
        
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

+4 -3

bin/main.ml

···

       1
       -
       (* Main entry point for the calendar CLI *)

     

       2
       -
       

     

       3
        
       open Cmdliner

     

       4
        
       

     

       5
        
       let list_cmd = List_cmd.cmd

     
···

       8
        
       let add_cmd = Add_cmd.cmd

     

       9
        
       let delete_cmd = Delete_cmd.cmd

     

       10
        
       let edit_cmd = Edit_cmd.cmd

     

       0
        
       
     

       11
        
       let doc = "Command-line calendar tool for managing local .ics files"

     

       12
        
       let version = "%%VERSION%%"

     

       13
        
       

     
···

       47
        
                      add_cmd ~fs calendar_dir;

     

       48
        
                      edit_cmd ~fs calendar_dir;

     

       49
        
                      delete_cmd ~fs calendar_dir;

     

       0
        
       
     

       0
        
       
     

       50
        
                    ])

     

       51
        
             with

     

       52
       -
             | Ok (`Ok n) -> n

     

       53
        
             | Ok _ -> 0

     

       54
        
             | Error _ -> 1)

     

       55

···

       0
        
       
     

       0
        
       
     

       1
        
       open Cmdliner

     

       2
        
       

     

       3
        
       let list_cmd = List_cmd.cmd

     
···

       6
        
       let add_cmd = Add_cmd.cmd

     

       7
        
       let delete_cmd = Delete_cmd.cmd

     

       8
        
       let edit_cmd = Edit_cmd.cmd

     

       9
       +
       let server_cmd = Server_cmd.cmd

     

       10
        
       let doc = "Command-line calendar tool for managing local .ics files"

     

       11
        
       let version = "%%VERSION%%"

     

       12
        
       

     
···

       46
        
                      add_cmd ~fs calendar_dir;

     

       47
        
                      edit_cmd ~fs calendar_dir;

     

       48
        
                      delete_cmd ~fs calendar_dir;

     

       49
       +
                      server_cmd ~stdin:(Eio.Stdenv.stdin env)

     

       50
       +
                        ~stdout:(Eio.Stdenv.stdout env) ~fs calendar_dir;

     

       51
        
                    ])

     

       52
        
             with

     

       53
       +
             | Ok (`Ok f) -> f ()

     

       54
        
             | Ok _ -> 0

     

       55
        
             | Error _ -> 1)

     

       56

+149 -32

bin/query_args.ml

···

       3
        
       

     

       4
        
       let from_arg =

     

       5
        
         let doc =

     

       6
       -
           "Start date in YYYY-MM-DD format or a relative expression (today, \

     

       7
       -
            tomorrow, this-week, next-week, this-month, next-month, +Nd, -Nd, +Nw, \

     

       8
       -
            +Nm)"

     

       9
        
         in

     

       10
        
         let i = Arg.info [ "from"; "f" ] ~docv:"DATE" ~doc in

     

       11
       -
         let parse_date s = Date.parse_date s `From in

     

       12
       -
         Arg.(value @@ opt (some (Cmdliner.Arg.conv (parse_date, Ptime.pp))) None i)

     

       13
        
       

     

       14
        
       let to_arg =

     

       15
        
         let doc =

     

       16
       -
           "End date in YYYY-MM-DD format or a relative expression (today, tomorrow, \

     

       17
       -
            this-week, next-week, this-month, next-month, +Nd, -Nd, +Nw, +Nm)"

     

       0
        
       
     

       18
        
         in

     

       19
        
         let i = Arg.info [ "to"; "t" ] ~docv:"DATE" ~doc in

     

       20
       -
         let parse_date s = Date.parse_date s `From in

     

       21
       -
         Arg.(value @@ opt (some (Cmdliner.Arg.conv (parse_date, Ptime.pp))) None i)

     

       22
        
       

     

       23
        
       let calendar_arg =

     

       24
       -
         let doc = "Calendar to filter by" in

     

       25
        
         Arg.(

     

       26
       -
           value

     

       27
       -
           & opt (some string) None

     

       28
       -
           & info [ "calendar"; "c" ] ~docv:"CALENDAR" ~doc)

     

       29
        
       

     

       30
        
       let format_enum =

     

       31
        
         [

     

       32
        
           ("text", `Text);

     

       0
        
       
     

       33
        
           ("json", `Json);

     

       34
        
           ("csv", `Csv);

     

       35
        
           ("ics", `Ics);

     

       36
       -
           ("records", `Entries);

     

       37
        
           ("sexp", `Sexp);

     

       38
        
         ]

     

       39
        
       

     

       40
        
       let format_arg =

     

       41
       -
         let doc = "Output format (text, json, csv, ics, table, sexp)" in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       42
        
         Arg.(

     

       43
        
           value

     

       44
        
           & opt (enum format_enum) `Text

     
···

       64
        
         let doc = "Show events for the current month" in

     

       65
        
         Arg.(value & flag & info [ "month"; "m" ] ~doc)

     

       66
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       67
        
       let date_format_manpage_entries =

     

       68
        
         [

     

       69
        
           `S "DATE FORMATS";

     

       70
       -
           `P "Date format flags:";

     

       71
       -
           `I ("--today, -d", "Show events for today only");

     

       72
       -
           `I ("--tomorrow", "Show events for tomorrow only");

     

       73
       -
           `I ("--week, -w", "Show events for the current week");

     

       74
       -
           `I ("--month, -m", "Show events for the current month");

     

       75
       -
           `P "Relative date formats for --from and --to:";

     

       0
        
       
     

       76
        
           `I ("today", "Current day");

     

       77
        
           `I ("tomorrow", "Next day");

     

       78
        
           `I ("yesterday", "Previous day");

     

       79
       -
           `I ("this-week", "Start of current week");

     

       80
       -
           `I ("next-week", "Start of next week");

     

       81
       -
           `I ("this-month", "Start of current month");

     

       82
       -
           `I ("next-month", "Start of next month");

     

       83
        
           `I ("+Nd", "N days from today (e.g., +7d for a week from today)");

     

       84
        
           `I ("-Nd", "N days before today (e.g., -7d for a week ago)");

     

       85
        
           `I ("+Nw", "N weeks from today (e.g., +4w for 4 weeks from today)");

     

       86
        
           `I ("+Nm", "N months from today (e.g., +2m for 2 months from today)");

     

       87
        
         ]

     

       88
       -
       

     

       89
       -
       let convert_relative_date ~today ~tomorrow ~week ~month =

     

       90
       -
         if today then Some "today"

     

       91
       -
         else if tomorrow then Some "tomorrow"

     

       92
       -
         else if week then Some "this-week"

     

       93
       -
         else if month then Some "this-month"

     

       94
       -
         else None

···

       3
        
       

     

       4
        
       let from_arg =

     

       5
        
         let doc =

     

       6
       +
           "Start date in YYYY-MM-DD format, partial date format (YYYY-MM or YYYY), \

     

       7
       +
            or a relative expression (today, tomorrow, this-week, next-week, \

     

       8
       +
            this-month, next-month, +Nd, -Nd, +Nw, +Nm). See DATE FORMATS for more."

     

       9
        
         in

     

       10
        
         let i = Arg.info [ "from"; "f" ] ~docv:"DATE" ~doc in

     

       11
       +
         Arg.(value @@ opt (some string) None i)

     

       0
        
       
     

       12
        
       

     

       13
        
       let to_arg =

     

       14
        
         let doc =

     

       15
       +
           "End date in YYYY-MM-DD format, partial date format (YYYY-MM or YYYY), or \

     

       16
       +
            a relative expression (today, tomorrow, this-week, next-week, this-month, \

     

       17
       +
            next-month, +Nd, -Nd, +Nw, +Nm). See DATE FORMATS for more."

     

       18
        
         in

     

       19
        
         let i = Arg.info [ "to"; "t" ] ~docv:"DATE" ~doc in

     

       20
       +
         Arg.(value @@ opt (some string) None i)

     

       0
        
       
     

       21
        
       

     

       22
        
       let calendar_arg =

     

       23
       +
         let doc = "Filter by calendar" in

     

       24
        
         Arg.(

     

       25
       +
           value & opt_all string [] & info [ "calendar"; "c" ] ~docv:"CALENDAR" ~doc)

     

       0
        
       
     

       0
        
       
     

       26
        
       

     

       27
        
       let format_enum =

     

       28
        
         [

     

       29
        
           ("text", `Text);

     

       30
       +
           ("entries", `Entries);

     

       31
        
           ("json", `Json);

     

       32
        
           ("csv", `Csv);

     

       33
        
           ("ics", `Ics);

     

       0
        
       
     

       34
        
           ("sexp", `Sexp);

     

       35
        
         ]

     

       36
        
       

     

       37
        
       let format_arg =

     

       38
       +
         let doc =

     

       39
       +
           "Output format (text, entries, json, csv, ics, sexp). Note that dates are \

     

       40
       +
            localised to the TIMEZONE option but the timezone they're defined in is \

     

       41
       +
            displayed."

     

       42
       +
         in

     

       43
        
         Arg.(

     

       44
        
           value

     

       45
        
           & opt (enum format_enum) `Text

     
···

       65
        
         let doc = "Show events for the current month" in

     

       66
        
         Arg.(value & flag & info [ "month"; "m" ] ~doc)

     

       67
        
       

     

       68
       +
       let timezone_arg =

     

       69
       +
         let doc =

     

       70
       +
           "Timezone to use for date calculations (e.g., 'America/New_York', 'UTC', \

     

       71
       +
            'Europe/London') defaulting to the system timezone"

     

       72
       +
         in

     

       73
       +
         Arg.(

     

       74
       +
           value

     

       75
       +
           & opt (some string) None

     

       76
       +
           & info [ "timezone"; "z" ] ~docv:"TIMEZONE" ~doc)

     

       77
       +
       

     

       78
       +
       let sort_field_enum =

     

       79
       +
         [

     

       80
       +
           ("start", `Start);

     

       81
       +
           ("end", `End);

     

       82
       +
           ("summary", `Summary);

     

       83
       +
           ("location", `Location);

     

       84
       +
           ("calendar", `Calendar);

     

       85
       +
         ]

     

       86
       +
       

     

       87
       +
       type sort_spec = {

     

       88
       +
         field : [ `Start | `End | `Summary | `Location | `Calendar ];

     

       89
       +
         descending : bool;

     

       90
       +
       }

     

       91
       +
       

     

       92
       +
       let parse_sort_spec str =

     

       93
       +
         let ( let* ) = Result.bind in

     

       94
       +
         let parts = String.split_on_char ':' str in

     

       95
       +
         match parts with

     

       96
       +
         | [] -> Error (`Msg "Empty sort specification")

     

       97
       +
         | field_str :: order_opt -> (

     

       98
       +
             let* descending =

     

       99
       +
               match order_opt with

     

       100
       +
               | [ "desc" ] | [ "descending" ] -> Ok true

     

       101
       +
               | [ "asc" ] | [ "ascending" ] -> Ok false

     

       102
       +
               | [] -> Ok false (* Default to ascending *)

     

       103
       +
               | _ -> Error (`Msg ("Invalid sort order in: " ^ str))

     

       104
       +
             in

     

       105
       +
             match List.assoc_opt field_str sort_field_enum with

     

       106
       +
             | Some field -> Ok { field; descending }

     

       107
       +
             | None ->

     

       108
       +
                 Error

     

       109
       +
                   (`Msg

     

       110
       +
                      (Printf.sprintf "Invalid sort field '%s'. Valid options are: %s"

     

       111
       +
                         field_str

     

       112
       +
                         (String.concat ", " (List.map fst sort_field_enum)))))

     

       113
       +
       

     

       114
       +
       let sort_converter =

     

       115
       +
         let parse s = parse_sort_spec s in

     

       116
       +
         let print ppf spec =

     

       117
       +
           let field_str =

     

       118
       +
             List.find_map

     

       119
       +
               (fun (name, field) -> if field = spec.field then Some name else None)

     

       120
       +
               sort_field_enum

     

       121
       +
           in

     

       122
       +
           let order_str = if spec.descending then ":desc" else "" in

     

       123
       +
           Fmt.pf ppf "%s%s" (Option.value field_str ~default:"unknown") order_str

     

       124
       +
         in

     

       125
       +
         Arg.conv (parse, print)

     

       126
       +
       

     

       127
       +
       let default_sort = { field = `Start; descending = false }

     

       128
       +
       

     

       129
       +
       let sort_arg =

     

       130
       +
         let doc =

     

       131
       +
           "Sorting specifications in the format 'field[:order]' where field is one \

     

       132
       +
            of 'start', 'end', 'summary', 'location', 'calendar' and order is one of \

     

       133
       +
            'asc'/'ascending' or 'desc'/'descending' (default: asc). Multiple sort \

     

       134
       +
            specs can be provided for multi-level sorting. When no sort is specified, \

     

       135
       +
            defaults to sorting by start time ascending."

     

       136
       +
         in

     

       137
       +
         Arg.(

     

       138
       +
           value

     

       139
       +
           & opt_all sort_converter [ default_sort ]

     

       140
       +
           & info [ "sort"; "S" ] ~docv:"SORT" ~doc)

     

       141
       +
       

     

       142
       +
       (* Convert sort specs to an event comparator *)

     

       143
       +
       let create_event_comparator sort_specs =

     

       144
       +
         match sort_specs with

     

       145
       +
         | [] -> Event.by_start

     

       146
       +
         | [ spec ] ->

     

       147
       +
             let comp =

     

       148
       +
               match spec.field with

     

       149
       +
               | `Start -> Event.by_start

     

       150
       +
               | `End -> Event.by_end

     

       151
       +
               | `Summary -> Event.by_summary

     

       152
       +
               | `Location -> Event.by_location

     

       153
       +
               | `Calendar -> Event.by_calendar_name

     

       154
       +
             in

     

       155
       +
             if spec.descending then Event.descending comp else comp

     

       156
       +
         | specs ->

     

       157
       +
             (* Chain multiple sort specs together *)

     

       158
       +
             List.fold_right

     

       159
       +
               (fun spec acc ->

     

       160
       +
                 let comp =

     

       161
       +
                   match spec.field with

     

       162
       +
                   | `Start -> Event.by_start

     

       163
       +
                   | `End -> Event.by_end

     

       164
       +
                   | `Summary -> Event.by_summary

     

       165
       +
                   | `Location -> Event.by_location

     

       166
       +
                   | `Calendar -> Event.by_calendar_name

     

       167
       +
                 in

     

       168
       +
                 let comp = if spec.descending then Event.descending comp else comp in

     

       169
       +
                 Event.chain comp acc)

     

       170
       +
               (List.tl specs)

     

       171
       +
               (let spec = List.hd specs in

     

       172
       +
                let comp =

     

       173
       +
                  match spec.field with

     

       174
       +
                  | `Start -> Event.by_start

     

       175
       +
                  | `End -> Event.by_end

     

       176
       +
                  | `Summary -> Event.by_summary

     

       177
       +
                  | `Location -> Event.by_location

     

       178
       +
                  | `Calendar -> Event.by_calendar_name

     

       179
       +
                in

     

       180
       +
                if spec.descending then Event.descending comp else comp)

     

       181
       +
       

     

       182
       +
       let parse_timezone ~timezone =

     

       183
       +
         match timezone with

     

       184
       +
         | Some tzid -> (

     

       185
       +
             match Timedesc.Time_zone.make tzid with

     

       186
       +
             | Some tz -> tz

     

       187
       +
             | None -> failwith ("Invalid timezone: " ^ tzid))

     

       188
       +
         | None -> !Date.default_timezone ()

     

       189
       +
       

     

       190
        
       let date_format_manpage_entries =

     

       191
        
         [

     

       192
        
           `S "DATE FORMATS";

     

       193
       +
           `P

     

       194
       +
             "The following are the possible date formats for the --from and --to \

     

       195
       +
              command line parameters. Note the value is dependent on --from / --to, \

     

       196
       +
              so --from 2025 --to 2025 will include all the events in the year 2025";

     

       197
       +
           `I ("YYYY-MM-DD", "Specific date (e.g., 2025-3-27, zero-padding optional)");

     

       198
       +
           `I ("YYYY-MM", "Start/end of specific month (e.g., 2025-3 for March 2025)");

     

       199
       +
           `I ("YYYY", "Start/end of specific year (e.g., 2025)");

     

       200
        
           `I ("today", "Current day");

     

       201
        
           `I ("tomorrow", "Next day");

     

       202
        
           `I ("yesterday", "Previous day");

     

       203
       +
           `I ("this-week", "Start/end of current week");

     

       204
       +
           `I ("next-week", "Start/end of next week");

     

       205
       +
           `I ("this-month", "Start/end of current month");

     

       206
       +
           `I ("next-month", "Start/end of next month");

     

       207
        
           `I ("+Nd", "N days from today (e.g., +7d for a week from today)");

     

       208
        
           `I ("-Nd", "N days before today (e.g., -7d for a week ago)");

     

       209
        
           `I ("+Nw", "N weeks from today (e.g., +4w for 4 weeks from today)");

     

       210
        
           `I ("+Nm", "N months from today (e.g., +2m for 2 months from today)");

     

       211
        
         ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+115 -83

bin/search_cmd.ml

···

       2
        
       open Caledonia_lib

     

       3
        
       open Query_args

     

       4
        
       

     

       5
       -
       let run ?from ?to_ ?calendar ?count ?query_text ~summary ~description ~location

     

       6
       -
           ~format ~today ~tomorrow ~week ~month ~recurring ~non_recurring ~fs

     

       7
       -
           calendar_dir =

     

       8
        
         let ( let* ) = Result.bind in

     

       9
        
         let filters = ref [] in

     

       10
       -
         let from, to_ =

     

       11
       -
           match Date.convert_relative_date_formats ~today ~tomorrow ~week ~month with

     

       12
       -
           | Some (from, to_) -> (Some from, to_)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       13
        
           | None -> (

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       14
        
               let max_date = Date.add_years (!Date.get_today ()) 75 in

     

       15
        
               match (from, to_) with

     

       16
       -
               | Some f, Some t -> (Some f, Date.to_end_of_day t)

     

       17
       -
               | Some f, None -> (Some f, Date.to_end_of_day max_date)

     

       18
       -
               | None, Some t -> (None, Date.to_end_of_day t)

     

       19
       -
               | None, None -> (None, Date.to_end_of_day max_date))

     

       20
        
         in

     

       21
        
         (match calendar with

     

       22
       -
         | Some collection_id ->

     

       23
       -
             filters :=

     

       24
       -
               Query.in_collections [ Collection.Col collection_id ] :: !filters

     

       25
       -
         | None -> ());

     

       26
        
         (match query_text with

     

       27
        
         | Some text ->

     

       28
       -
             if summary then filters := Query.summary_contains text :: !filters;

     

       29
       -
             if description then filters := Query.description_contains text :: !filters;

     

       30
       -
             if location then filters := Query.location_contains text :: !filters;

     

       31
        
             if not (summary || description || location) then

     

       32
        
               filters :=

     

       33
       -
                 Query.or_filter

     

       34
        
                   [

     

       35
       -
                     Query.summary_contains text;

     

       36
       -
                     Query.description_contains text;

     

       37
       -
                     Query.location_contains text;

     

       38
        
                   ]

     

       39
        
                 :: !filters

     

       40
        
         | None -> ());

     

       41
       -
         if recurring then filters := Query.recurring_only () :: !filters;

     

       42
       -
         if non_recurring then filters := Query.non_recurring_only () :: !filters;

     

       43
       -
         let filter = Query.and_filter !filters in

     

       44
       -
         let* results =

     

       45
       -
           Query.query ~fs calendar_dir ~filter ~from ~to_ ?limit:count ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       46
        
         in

     

       47
       -
         if results = [] then print_endline "No events found."

     

       48
       -
         else print_endline (Format.format_instances ~format results);

     

       49
        
         Ok ()

     

       50
        
       

     

       51
        
       let query_text_arg =

     

       52
       -
         let doc = "Text to search for in events (summary, description, location)" in

     

       0
        
       
     

       0
        
       
     

       53
        
         Arg.(value & pos 0 (some string) None & info [] ~docv:"TEXT" ~doc)

     

       54
        
       

     

       55
        
       let summary_arg =

     
···

       72
        
         let doc = "Search for non-recurring events only" in

     

       73
        
         Arg.(value & flag & info [ "non-recurring"; "R" ] ~doc)

     

       74
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       75
        
       let cmd ~fs calendar_dir =

     

       76
       -
         let run query_text from to_ calendar count format summary description location

     

       77
       -
             today tomorrow week month recurring non_recurring =

     

       0
        
       
     

       78
        
           match

     

       79
       -
             run ?from ?to_ ?calendar ?count ?query_text ~summary ~description

     

       80
       -
               ~location ~format ~today ~tomorrow ~week ~month ~recurring

     

       81
       -
               ~non_recurring ~fs calendar_dir

     

       82
        
           with

     

       83
        
           | Error (`Msg msg) ->

     

       84
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       88
        
         let term =

     

       89
        
           Term.(

     

       90
        
             const run $ query_text_arg $ from_arg $ to_arg $ calendar_arg $ count_arg

     

       91
       -
             $ format_arg $ summary_arg $ description_arg $ location_arg $ today_arg

     

       92
       -
             $ tomorrow_arg $ week_arg $ month_arg $ recurring_arg $ non_recurring_arg)

     

       0
        
       
     

       93
        
         in

     

       94
        
         let doc = "Search calendar events for specific text" in

     

       95
        
         let man =

     
···

       97
        
             `S Manpage.s_description;

     

       98
        
             `P

     

       99
        
               "Search calendar events for text in summary, description, or location \

     

       100
       -
                fields.";

     

       101
       -
             `P

     

       102
       -
               "By default, the search looks across all text fields in all events \

     

       103
       -
                regardless of date.";

     

       104
       -
             `P

     

       105
       -
               "You can narrow the search to a specific date range with date flags or \

     

       106
       -
                --from and --to.";

     

       107
       -
             `P

     

       108
       -
               "You can specify specific fields to search in using the --summary, \

     

       109
       -
                --description, or --location flags.";

     

       110
       -
             `P

     

       111
       -
               "You can limit results to only recurring or non-recurring events using \

     

       112
       -
                the --recurring or --non-recurring flags.";

     

       113
       -
             `P

     

       114
       -
               "The search text is optional if you're using other filters. For \

     

       115
       -
                example, you can find all recurring events without specifying any \

     

       116
       -
                search text.";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       117
        
             `S Manpage.s_options;

     

       118
        
           ]

     

       119
        
           @ date_format_manpage_entries

     

       120
       -
           @ [

     

       121
       -
               `S Manpage.s_examples;

     

       122
       -
               `I ("Search for 'meeting' in all events:", "caled search meeting");

     

       123
       -
               `I

     

       124
       -
                 ( "Search for 'interview' in event summaries only:",

     

       125
       -
                   "caled search --summary interview" );

     

       126
       -
               `I

     

       127
       -
                 ( "Search for 'conference' in a specific calendar:",

     

       128
       -
                   "caled search --calendar work conference" );

     

       129
       -
               `I

     

       130
       -
                 ( "Search for 'workshop' in event descriptions for today only:",

     

       131
       -
                   "caled search --description --today workshop" );

     

       132
       -
               `I

     

       133
       -
                 ( "Search for 'project' in events this month:",

     

       134
       -
                   "caled search --month project" );

     

       135
       -
               `I

     

       136
       -
                 ( "Search for 'workshop' in event descriptions within a date range:",

     

       137
       -
                   "caled search --description --from 2025-03-27 --to 2025-04-01 \

     

       138
       -
                    workshop" );

     

       139
       -
               `I

     

       140
       -
                 ( "Search for recurring events only:",

     

       141
       -
                   "caled search --recurring meeting" );

     

       142
       -
               `I

     

       143
       -
                 ( "Search for non-recurring events only:",

     

       144
       -
                   "caled search --non-recurring appointment" );

     

       145
       -
               `I ("Find all recurring events:", "caled search --recurring");

     

       146
       -
               `I

     

       147
       -
                 ( "Find all events in a specific calendar:",

     

       148
       -
                   "caled search --calendar work" );

     

       149
       -
             ]

     

       150
        
         in

     

       151
        
         let exit_info =

     

       152
        
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

···

       2
        
       open Caledonia_lib

     

       3
        
       open Query_args

     

       4
        
       

     

       5
       +
       let run ?from_str ?to_str ~calendar ?count ?query_text ~summary ~description

     

       6
       +
           ~location ~id ~format ~today ~tomorrow ~week ~month ~recurring

     

       7
       +
           ~non_recurring ?timezone ~sort ~fs calendar_dir =

     

       8
        
         let ( let* ) = Result.bind in

     

       9
        
         let filters = ref [] in

     

       10
       +
         let tz = Query_args.parse_timezone ~timezone in

     

       11
       +
         let* from, to_ =

     

       12
       +
           match

     

       13
       +
             Date.convert_relative_date_formats ~tz ~today ~tomorrow ~week ~month ()

     

       14
       +
           with

     

       15
       +
           | Some (from, to_) ->

     

       16
       +
               let* _ =

     

       17
       +
                 match (from_str, to_str) with

     

       18
       +
                 | None, None -> Ok ()

     

       19
       +
                 | _ ->

     

       20
       +
                     Error

     

       21
       +
                       (`Msg

     

       22
       +
                          "Can't specify --from / --to when using --today, --week, \

     

       23
       +
                           --month")

     

       24
       +
               in

     

       25
       +
               Ok (Some from, to_)

     

       26
        
           | None -> (

     

       27
       +
               let* from =

     

       28
       +
                 match from_str with

     

       29
       +
                 | None -> Ok None

     

       30
       +
                 | Some s ->

     

       31
       +
                     let* d = Date.parse_date s `From in

     

       32
       +
                     Ok (Some d)

     

       33
       +
               in

     

       34
       +
               let* to_ =

     

       35
       +
                 match to_str with

     

       36
       +
                 | None -> Ok None

     

       37
       +
                 | Some s ->

     

       38
       +
                     let* d = Date.parse_date s `To in

     

       39
       +
                     Ok (Some d)

     

       40
       +
               in

     

       41
        
               let max_date = Date.add_years (!Date.get_today ()) 75 in

     

       42
        
               match (from, to_) with

     

       43
       +
               | Some f, Some t -> Ok (Some f, Date.to_end_of_day t)

     

       44
       +
               | Some f, None -> Ok (Some f, Date.to_end_of_day max_date)

     

       45
       +
               | None, Some t -> Ok (None, Date.to_end_of_day t)

     

       46
       +
               | None, None -> Ok (None, Date.to_end_of_day max_date))

     

       47
        
         in

     

       48
        
         (match calendar with

     

       49
       +
         | [] -> ()

     

       50
       +
         | calendars -> filters := Event.in_calendars calendars :: !filters);

     

       0
        
       
     

       0
        
       
     

       51
        
         (match query_text with

     

       52
        
         | Some text ->

     

       53
       +
             if summary then filters := Event.summary_contains text :: !filters;

     

       54
       +
             if description then filters := Event.description_contains text :: !filters;

     

       55
       +
             if location then filters := Event.location_contains text :: !filters;

     

       56
        
             if not (summary || description || location) then

     

       57
        
               filters :=

     

       58
       +
                 Event.or_filter

     

       59
        
                   [

     

       60
       +
                     Event.summary_contains text;

     

       61
       +
                     Event.description_contains text;

     

       62
       +
                     Event.location_contains text;

     

       63
        
                   ]

     

       64
        
                 :: !filters

     

       65
        
         | None -> ());

     

       66
       +
         if recurring then filters := Event.recurring_only () :: !filters;

     

       67
       +
         if non_recurring then filters := Event.non_recurring_only () :: !filters;

     

       68
       +
         (match id with

     

       69
       +
         | Some id -> filters := Event.with_id id :: !filters

     

       70
       +
         | None -> ());

     

       71
       +
         let filter = Event.and_filter !filters in

     

       72
       +
         let comparator = Query_args.create_event_comparator sort in

     

       73
       +
         let* events = Calendar_dir.get_events ~fs calendar_dir in

     

       74
       +
         let events =

     

       75
       +
           Event.query events ~filter ~from ~to_ ~comparator ?limit:count ()

     

       76
        
         in

     

       77
       +
         if events = [] then print_endline "No events found."

     

       78
       +
         else print_endline (Event.format_events ~tz ~format events);

     

       79
        
         Ok ()

     

       80
        
       

     

       81
        
       let query_text_arg =

     

       82
       +
         let doc =

     

       83
       +
           "Text to search for in the fields summary, description, and/or location."

     

       84
       +
         in

     

       85
        
         Arg.(value & pos 0 (some string) None & info [] ~docv:"TEXT" ~doc)

     

       86
        
       

     

       87
        
       let summary_arg =

     
···

       104
        
         let doc = "Search for non-recurring events only" in

     

       105
        
         Arg.(value & flag & info [ "non-recurring"; "R" ] ~doc)

     

       106
        
       

     

       107
       +
       let id_arg =

     

       108
       +
         let doc = "Search for an event with a specific ID" in

     

       109
       +
         Arg.(value & opt (some string) None & info [ "id"; "i" ] ~docv:"ID" ~doc)

     

       110
       +
       

     

       111
        
       let cmd ~fs calendar_dir =

     

       112
       +
         let run query_text from_str to_str calendars count format summary description

     

       113
       +
             location id today tomorrow week month recurring non_recurring timezone

     

       114
       +
             sort () =

     

       115
        
           match

     

       116
       +
             run ?from_str ?to_str ~calendar:calendars ?count ?query_text ~summary

     

       117
       +
               ~description ~location ~id ~format ~today ~tomorrow ~week ~month

     

       118
       +
               ~recurring ~non_recurring ?timezone ~sort ~fs calendar_dir

     

       119
        
           with

     

       120
        
           | Error (`Msg msg) ->

     

       121
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       125
        
         let term =

     

       126
        
           Term.(

     

       127
        
             const run $ query_text_arg $ from_arg $ to_arg $ calendar_arg $ count_arg

     

       128
       +
             $ format_arg $ summary_arg $ description_arg $ location_arg $ id_arg

     

       129
       +
             $ today_arg $ tomorrow_arg $ week_arg $ month_arg $ recurring_arg

     

       130
       +
             $ non_recurring_arg $ timezone_arg $ sort_arg)

     

       131
        
         in

     

       132
        
         let doc = "Search calendar events for specific text" in

     

       133
        
         let man =

     
···

       135
        
             `S Manpage.s_description;

     

       136
        
             `P

     

       137
        
               "Search calendar events for text in summary, description, or location \

     

       138
       +
                fields. By default, the search looks across all text fields in all \

     

       139
       +
                events regardless of date. You can specify specific fields to search \

     

       140
       +
                in using the --summary, --description, or --location flags. You can \

     

       141
       +
                use date flags to show events for a specific time period, and filter \

     

       142
       +
                events with the --sort option.\n\

     

       143
       +
               \        The search text is optional, so you search events according \

     

       144
       +
                to other query criteria.";

     

       145
       +
             `S Manpage.s_examples;

     

       146
       +
             `I ("Search for 'meeting' in all events:", "caled search meeting");

     

       147
       +
             `I

     

       148
       +
               ( "Search for 'interview' in event summaries only:",

     

       149
       +
                 "caled search --summary interview" );

     

       150
       +
             `I

     

       151
       +
               ( "Search for 'conference' in a specific calendar:",

     

       152
       +
                 "caled search --calendar work conference" );

     

       153
       +
             `I

     

       154
       +
               ( "Search for 'workshop' in event descriptions for today only:",

     

       155
       +
                 "caled search --description --today workshop" );

     

       156
       +
             `I

     

       157
       +
               ( "Search for 'project' in events this month:",

     

       158
       +
                 "caled search --month project" );

     

       159
       +
             `I

     

       160
       +
               ( "Search for 'workshop' in event descriptions within a date range:",

     

       161
       +
                 "caled search --description --from 2025-03-27 --to 2025-04-01 \

     

       162
       +
                  workshop" );

     

       163
       +
             `I

     

       164
       +
               ("Search for recurring events only:", "caled search --recurring meeting");

     

       165
       +
             `I

     

       166
       +
               ( "Search for non-recurring events only:",

     

       167
       +
                 "caled search --non-recurring appointment" );

     

       168
       +
             `I ("Find all recurring events:", "caled search --recurring");

     

       169
       +
             `I

     

       170
       +
               ( "Find all events in a specific calendar:",

     

       171
       +
                 "caled search --calendar work" );

     

       172
       +
             `I

     

       173
       +
               ( "Sort results by location and then summary:",

     

       174
       +
                 "caled search --sort location --sort summary" );

     

       175
       +
             `I

     

       176
       +
               ( "Sort results by end time in descending order:",

     

       177
       +
                 "caled search --sort end:desc" );

     

       178
        
             `S Manpage.s_options;

     

       179
        
           ]

     

       180
        
           @ date_format_manpage_entries

     

       181
       +
           @ [ `S Manpage.s_see_also ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       182
        
         in

     

       183
        
         let exit_info =

     

       184
        
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

+85

bin/server_cmd.ml

···

       1
       +
       open Eio

     

       2
       +
       open Cmdliner

     

       3
       +
       open Caledonia_lib

     

       4
       +
       open Caledonia_lib.Sexp

     

       5
       +
       

     

       6
       +
       let run ~stdin ~stdout ~fs calendar_dir () =

     

       7
       +
         let reader = Buf_read.of_flow stdin ~max_size:1_000_000 in

     

       8
       +
         let ( let* ) = Result.bind in

     

       9
       +
         

     

       10
       +
         (* Initialize mutable events variable - will be updated on refresh *)

     

       11
       +
         let mutable_events = ref (Calendar_dir.get_events ~fs calendar_dir) in

     

       12
       +
         

     

       13
       +
         try

     

       14
       +
           while true do

     

       15
       +
             let line = Buf_read.line reader in

     

       16
       +
             let response =

     

       17
       +
               try

     

       18
       +
                 let sexp = Sexplib.Sexp.of_string line in

     

       19
       +
                 let request = Sexp.request_of_sexp sexp in

     

       20
       +
                 match request with

     

       21
       +
                 | ListCalendars ->

     

       22
       +
                     let* names = Calendar_dir.list_calendar_names ~fs calendar_dir in

     

       23
       +
                     Ok (sexp_of_response (Ok (Calendars names)))

     

       24
       +
                 | Refresh ->

     

       25
       +
                     (* Reload events from disk *)

     

       26
       +
                     mutable_events := Calendar_dir.get_events ~fs calendar_dir;

     

       27
       +
                     (* Return an empty response *)

     

       28
       +
                     Ok (sexp_of_response (Ok Empty))

     

       29
       +
                 | Query query_req ->

     

       30
       +
                     let* filter, from, to_, limit, _tz =

     

       31
       +
                       generate_query_params query_req

     

       32
       +
                     in

     

       33
       +
                     let* events = !mutable_events in

     

       34
       +
                     let events = Event.query events ~filter ~from ~to_ ?limit () in

     

       35
       +
                     Ok (sexp_of_response (Ok (Events events)))

     

       36
       +
               with

     

       37
       +
               | Sexplib.Conv.Of_sexp_error (_exn, bad_sexp) ->

     

       38
       +
                   let msg =

     

       39
       +
                     Printf.sprintf "Invalid request format for '%s': %s" line

     

       40
       +
                       (to_string bad_sexp)

     

       41
       +
                   in

     

       42
       +
                   Ok (sexp_of_response (Error msg))

     

       43
       +
               | Failure msg ->

     

       44
       +
                   Ok (sexp_of_response (Error ("Processing failed: " ^ msg)))

     

       45
       +
               | exn ->

     

       46
       +
                   let msg =

     

       47
       +
                     Printf.sprintf "Unexpected error: %s" (Printexc.to_string exn)

     

       48
       +
                   in

     

       49
       +
                   Ok (sexp_of_response (Error msg))

     

       50
       +
             in

     

       51
       +
             let response_line =

     

       52
       +
               to_string

     

       53
       +
                 (match response with

     

       54
       +
                 | Ok r -> r

     

       55
       +
                 | Error (`Msg msg) -> Sexp.sexp_of_response (Error msg))

     

       56
       +
             in

     

       57
       +
             Flow.copy_string (response_line ^ "\n") stdout

     

       58
       +
           done

     

       59
       +
         with End_of_file -> ()

     

       60
       +
       

     

       61
       +
       let cmd ~stdin ~stdout ~fs calendar_dir =

     

       62
       +
         let run () =

     

       63
       +
           let _ = run ~stdin ~stdout ~fs calendar_dir () in

     

       64
       +
           0

     

       65
       +
         in

     

       66
       +
         let term = Term.(const run) in

     

       67
       +
       

     

       68
       +
         let doc = "Process single-line S-expression requests from stdin to stdout." in

     

       69
       +
         let man =

     

       70
       +
           [

     

       71
       +
             `S Manpage.s_description;

     

       72
       +
             `P

     

       73
       +
               "$(mname) $(tname) reads S-expression requests (one per line) from \

     

       74
       +
                stdin, processes them, and writes S-expression responses (one per \

     

       75
       +
                line) to stdout.";

     

       76
       +
             `P "Example request: '(Query (()))'";

     

       77
       +
             `P

     

       78
       +
               "Example response: '(Ok (Events ((id ...) (summary ...) ...)))' or \

     

       79
       +
                '(Error \"...\")'";

     

       80
       +
             `S Manpage.s_examples;

     

       81
       +
             `Pre "echo '(Query ((text \\\"meeting\\\")))' | $(mname) $(tname)";

     

       82
       +
           ]

     

       83
       +
         in

     

       84
       +
         let info = Cmd.info "server" ~doc ~man in

     

       85
       +
         Cmd.v info term

+11 -9

bin/show_cmd.ml

···

       3
        
       

     

       4
        
       let run ~event_id ~format ~fs calendar_dir =

     

       5
        
         let ( let* ) = Result.bind in

     

       6
       -
         let filter = Query.with_id event_id in

     

       7
       -
         let* results = Query.query_events ~fs calendar_dir ~filter () in

     

       0
        
       
     

       8
        
         if results = [] then print_endline "No events found."

     

       9
       -
         else print_endline (Format.format_events ~format results);

     

       10
        
         Ok ()

     

       11
        
       

     

       12
        
       let event_id_arg =

     
···

       21
        
           & info [ "format"; "o" ] ~docv:"FORMAT" ~doc)

     

       22
        
       

     

       23
        
       let cmd ~fs calendar_dir =

     

       24
       -
         let run event_id format =

     

       25
        
           match run ~event_id ~format ~fs calendar_dir with

     

       26
        
           | Error (`Msg msg) ->

     

       27
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       34
        
           [

     

       35
        
             `S Manpage.s_description;

     

       36
        
             `P "Show detailed information about a specific event by its ID.";

     

       37
       -
             `P

     

       38
       -
               "You can find event IDs by using the `list` or `search` commands with \

     

       39
       -
                the `id` output using `-o id`.";

     

       40
       -
             `S Manpage.s_options;

     

       41
        
             `S Manpage.s_examples;

     

       42
        
             `P "Show event details:";

     

       43
        
             `P "  caled show 12345678-1234-5678-1234-567812345678";

     

       44
        
             `P "Show event details in JSON format:";

     

       45
        
             `P "  caled show 12345678-1234-5678-1234-567812345678 --format json";

     

       0
        
       
     

       46
        
           ]

     

       47
        
         in

     

       48
       -
         let info = Cmd.info "show" ~doc ~man in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       49
        
         Cmd.v info term

···

       3
        
       

     

       4
        
       let run ~event_id ~format ~fs calendar_dir =

     

       5
        
         let ( let* ) = Result.bind in

     

       6
       +
         let filter = Event.with_id event_id in

     

       7
       +
         let* events = Calendar_dir.get_events ~fs calendar_dir in

     

       8
       +
         let results = Event.query_without_recurrence events ~filter () in

     

       9
        
         if results = [] then print_endline "No events found."

     

       10
       +
         else print_endline (Event.format_events ~format results);

     

       11
        
         Ok ()

     

       12
        
       

     

       13
        
       let event_id_arg =

     
···

       22
        
           & info [ "format"; "o" ] ~docv:"FORMAT" ~doc)

     

       23
        
       

     

       24
        
       let cmd ~fs calendar_dir =

     

       25
       +
         let run event_id format () =

     

       26
        
           match run ~event_id ~format ~fs calendar_dir with

     

       27
        
           | Error (`Msg msg) ->

     

       28
        
               Printf.eprintf "Error: %s\n%!" msg;

     
···

       35
        
           [

     

       36
        
             `S Manpage.s_description;

     

       37
        
             `P "Show detailed information about a specific event by its ID.";

     

       38
       +
             `P "You can find event IDs by using the `list` or `search` commands.";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       39
        
             `S Manpage.s_examples;

     

       40
        
             `P "Show event details:";

     

       41
        
             `P "  caled show 12345678-1234-5678-1234-567812345678";

     

       42
        
             `P "Show event details in JSON format:";

     

       43
        
             `P "  caled show 12345678-1234-5678-1234-567812345678 --format json";

     

       44
       +
             `S Manpage.s_options;

     

       45
        
           ]

     

       46
        
         in

     

       47
       +
         let exit_info =

     

       48
       +
           [ Cmd.Exit.info ~doc:"on success." 0; Cmd.Exit.info ~doc:"on error." 1 ]

     

       49
       +
         in

     

       50
       +
         let info = Cmd.info "show" ~doc ~man ~exits:exit_info in

     

       51
        
         Cmd.v info term

+7 -2

caledonia.opam

···

       1
        
       opam-version: "2.0"

     

       2
       -
       version: "0.1.0"

     

       3
        
       maintainer: "Ryan Gibb <ryan@freumh.org"

     

       4
        
       authors: ["Ryan Gibb <ryan@freumh.org"]

     

       5
        
       homepage: "https://ryan.freumh.org/caledonia.html"

     
···

       14
        
       depends: [

     

       15
        
         "ocaml" {>= "4.08.0"}

     

       16
        
         "dune" {>= "3.4"}

     

       17
       -
         "icalendar" {>= "0.1.10"}

     

       18
        
         "cmdliner" {>= "1.3.0"}

     

       19
        
         "ptime" {>= "1.2"}

     

       20
        
         "fmt" {>= "0.9.0"}

     
···

       26
        
         "eio_main" {>= "0.12"}

     

       27
        
         "timere" {>= "0.8.0"}

     

       28
        
         "timedesc" {>= "0.8.0"}

     

       0
        
       
     

       29
        
         "alcotest" {>= "1.8.0" & with-test}

     

       30
        
       ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
        
       opam-version: "2.0"

     

       2
       +
       version: "0.4.0"

     

       3
        
       maintainer: "Ryan Gibb <ryan@freumh.org"

     

       4
        
       authors: ["Ryan Gibb <ryan@freumh.org"]

     

       5
        
       homepage: "https://ryan.freumh.org/caledonia.html"

     
···

       14
        
       depends: [

     

       15
        
         "ocaml" {>= "4.08.0"}

     

       16
        
         "dune" {>= "3.4"}

     

       17
       +
         "icalendar" {= "dev"}

     

       18
        
         "cmdliner" {>= "1.3.0"}

     

       19
        
         "ptime" {>= "1.2"}

     

       20
        
         "fmt" {>= "0.9.0"}

     
···

       26
        
         "eio_main" {>= "0.12"}

     

       27
        
         "timere" {>= "0.8.0"}

     

       28
        
         "timedesc" {>= "0.8.0"}

     

       29
       +
         "ppx_sexp_conv" {>= "0.15.1"}

     

       30
        
         "alcotest" {>= "1.8.0" & with-test}

     

       31
        
       ]

     

       32
       +
       pin-depends: [

     

       33
       +
         # https://github.com/robur-coop/icalendar/pull/13

     

       34
       +
         ["icalendar.dev" "git+https://github.com/robur-coop/icalendar#1ab8d3970295bc96dc651c53b25c7c9963a27f81"]

     

       35
       +
       ]

+2 -2

dune-project

···

       1
        
       (lang dune 3.4)

     

       2
        
       (name caledonia)

     

       3
       -
       (version 0.1.0)

     

       4
       -
       (using directory-targets 0.1)

···

       1
        
       (lang dune 3.4)

     

       2
        
       (name caledonia)

     

       3
       +
       (version 0.4.0)

     

       4
       +
       (using directory-targets 0.1)

+56

emacs/caledonia-evil.el

···

       1
       +
       ;;; caledonia-evil.el --- Evil bindings for Caledonia -*- lexical-binding: t; -*-

     

       2
       +
       ;;

     

       3
       +
       ;; Copyright (C) 2025 Ryan Gibb

     

       4
       +
       ;;

     

       5
       +
       ;; Author: Ryan Gibb <ryan@freumh.org>

     

       6
       +
       ;; Maintainer: Ryan Gibb <ryan@freumh.org>

     

       7
       +
       ;; Version: 0.4.0

     

       8
       +
       ;; Keywords: calendar

     

       9
       +
       ;; Package-Requires: ((emacs "24.3"))

     

       10
       +
       ;; URL: https://ryan.freumh.org/caledonia.html

     

       11
       +
       ;;

     

       12
       +
       ;; This file is not part of GNU Emacs.

     

       13
       +
       ;;

     

       14
       +
       ;;; Commentary:

     

       15
       +
       ;;

     

       16
       +
       ;; This package provides Evil bindings for Caledonia.

     

       17
       +
       ;;

     

       18
       +
       ;;; Code:

     

       19
       +
       

     

       20
       +
       (require 'evil)

     

       21
       +
       (require 'caledonia)

     

       22
       +
       

     

       23
       +
       (defvar caledonia-evil-filter-map

     

       24
       +
         (let ((map (make-sparse-keymap)))

     

       25
       +
           (define-key map "d" 'caledonia-query-date-range)

     

       26
       +
           (define-key map "c" 'caledonia-query-calendars)

     

       27
       +
           (define-key map "t" 'caledonia-query-text)

     

       28
       +
           (define-key map "i" 'caledonia-query-id)

     

       29
       +
           (define-key map "r" 'caledonia-query-recurring)

     

       30
       +
           (define-key map "l" 'caledonia-query-limit)

     

       31
       +
           (define-key map "z" 'caledonia-query-timezone)

     

       32
       +
           map)

     

       33
       +
         "Evil mode keymap for filter commands in Caledonia mode.")

     

       34
       +
       

     

       35
       +
       (defun caledonia-evil--setup-evil-bindings ()

     

       36
       +
         "Set up Evil keybindings for `caledonia-mode`."

     

       37
       +
         (evil-define-key 'normal caledonia-mode-map

     

       38
       +
           (kbd "RET") 'caledonia-show-event

     

       39
       +
           (kbd "M-RET") 'caledonia-open-event-file

     

       40
       +
           "l" 'caledonia-list

     

       41
       +
           "s" 'caledonia-search

     

       42
       +
           "r" 'caledonia-refresh

     

       43
       +
           "q" 'quit-window

     

       44
       +
           "f" caledonia-evil-filter-map))

     

       45
       +
       

     

       46
       +
       (defun caledonia-evil--setup-evil-integration ()

     

       47
       +
         "Set up Evil integration for Caledonia mode."

     

       48
       +
         (when (bound-and-true-p evil-mode)

     

       49
       +
           (evil-make-overriding-map caledonia-mode-map 'normal)

     

       50
       +
           (evil-normalize-keymaps)

     

       51
       +
           (caledonia-evil--setup-evil-bindings)))

     

       52
       +
       

     

       53
       +
       (add-hook 'caledonia-mode-hook 'caledonia-evil--setup-evil-integration)

     

       54
       +
       

     

       55
       +
       (provide 'caledonia-evil)

     

       56
       +
       ;;; caledonia-evil.el ends here

+788

emacs/caledonia.el

···

       1
       +
       ;;; caledonia.el --- Emacs integration for Caledonia -*- lexical-binding: t -*-

     

       2
       +
       

     

       3
       +
       ;; Copyright (C) 2025 Ryan Gibb

     

       4
       +
       

     

       5
       +
       ;; Author: Ryan Gibb <ryan@freumh.org>

     

       6
       +
       ;; Maintainer: Ryan Gibb <ryan@freumh.org>

     

       7
       +
       ;; Version: 0.4.0

     

       8
       +
       ;; Keywords: calendar

     

       9
       +
       ;; Package-Requires: ((emacs "24.4"))

     

       10
       +
       ;; URL: https://ryan.freumh.org/caledonia.html

     

       11
       +
       

     

       12
       +
       ;; This file is not part of GNU Emacs.

     

       13
       +
       

     

       14
       +
       ;;; Commentary:

     

       15
       +
       

     

       16
       +
       ;; This package provides an Emacs interface to the Caledonia calendar CLI.

     

       17
       +
       ;; It communicates with Caledonia using S-expressions for data exchange.

     

       18
       +
       

     

       19
       +
       ;;; Code:

     

       20
       +
       

     

       21
       +
       (require 'cl-lib)

     

       22
       +
       (require 'calendar)

     

       23
       +
       (require 'pulse nil t)

     

       24
       +
       (require 'org)

     

       25
       +
       

     

       26
       +
       (defgroup caledonia nil

     

       27
       +
         "Interface to Caledonia calendar client."

     

       28
       +
         :group 'calendar

     

       29
       +
         :prefix "caledonia-")

     

       30
       +
       

     

       31
       +
       (defcustom caledonia-executable (executable-find "caled")

     

       32
       +
         "Path to the Caledonia executable."

     

       33
       +
         :type 'string

     

       34
       +
         :group 'caledonia)

     

       35
       +
       

     

       36
       +
       (defface caledonia-calendar-name-face

     

       37
       +
         '((t :inherit font-lock-function-name-face))

     

       38
       +
         "Face used for calendar names in the events view."

     

       39
       +
         :group 'caledonia)

     

       40
       +
       

     

       41
       +
       (defface caledonia-date-face

     

       42
       +
         '((t :inherit font-lock-string-face))

     

       43
       +
         "Face used for dates in the events view."

     

       44
       +
         :group 'caledonia)

     

       45
       +
       

     

       46
       +
       (defface caledonia-summary-face

     

       47
       +
         '((t :inherit default))

     

       48
       +
         "Face used for event summaries in the events view."

     

       49
       +
         :group 'caledonia)

     

       50
       +
       

     

       51
       +
       (defface caledonia-location-face

     

       52
       +
         '((t :inherit font-lock-comment-face))

     

       53
       +
         "Face used for event locations in the events view."

     

       54
       +
         :group 'caledonia)

     

       55
       +
       

     

       56
       +
       (defcustom caledonia-calendar-column-width 0

     

       57
       +
         "Column width for the Calendar entry."

     

       58
       +
         :type 'natnum)

     

       59
       +
       

     

       60
       +
       (defcustom caledonia-start-column-width 0

     

       61
       +
         "Column width for the Start entry."

     

       62
       +
         :type 'natnum)

     

       63
       +
       

     

       64
       +
       (defcustom caledonia-end-column-width 0

     

       65
       +
         "Column width for the End entry."

     

       66
       +
         :type 'natnum)

     

       67
       +
       

     

       68
       +
       (defcustom caledonia-list-from-date "today"

     

       69
       +
         "Default start date for calendar list view."

     

       70
       +
         :type 'string

     

       71
       +
         :group 'caledonia)

     

       72
       +
       

     

       73
       +
       (defcustom caledonia-list-to-date "+3m"

     

       74
       +
         "Default end date for calendar list view (3 months from today)."

     

       75
       +
         :type 'string

     

       76
       +
         :group 'caledonia)

     

       77
       +
       

     

       78
       +
       (defcustom caledonia-search-from-date nil

     

       79
       +
         "Default start date for calendar search; nil means no start date limit."

     

       80
       +
         :type 'string

     

       81
       +
         :group 'caledonia)

     

       82
       +
       

     

       83
       +
       (defcustom caledonia-search-to-date "+75y"

     

       84
       +
         "Default end date for calendar search (75 years from today)."

     

       85
       +
         :type 'string

     

       86
       +
         :group 'caledonia)

     

       87
       +
       

     

       88
       +
       ;; Define histories for input fields

     

       89
       +
       

     

       90
       +
       (defvar caledonia-from-history nil "History for from date inputs.")

     

       91
       +
       (defvar caledonia-to-history nil "History for to date inputs.")

     

       92
       +
       (defvar caledonia-timezone-history nil "History for timezone inputs.")

     

       93
       +
       (defvar caledonia-calendars-history nil "History for calendar inputs.")

     

       94
       +
       (defvar caledonia-text-history nil "History for search text inputs.")

     

       95
       +
       (defvar caledonia-search-fields-history nil "History for search fields inputs.")

     

       96
       +
       (defvar caledonia-id-history nil "History for event ID inputs.")

     

       97
       +
       (defvar caledonia-limit-history nil "History for limit inputs.")

     

       98
       +
       (defvar caledonia-search-prompt-history nil "History for search prompt inputs.")

     

       99
       +
       

     

       100
       +
       ;; Internal variables

     

       101
       +
       

     

       102
       +
       (defvar caledonia--events-buffer "*Caledonia Events*"

     

       103
       +
         "Buffer name for displaying Caledonia events.")

     

       104
       +
       (defvar caledonia--details-buffer "*Caledonia Event Details*"

     

       105
       +
         "Buffer name for displaying Caledonia event details.")

     

       106
       +
       (defvar caledonia--server-process nil

     

       107
       +
         "The persistent Caledonia server process.")

     

       108
       +
       (defvar caledonia--server-buffer-name "*caledonia-server-io*"

     

       109
       +
         "Buffer for server process I/O.")

     

       110
       +
       (defvar caledonia--response-line nil

     

       111
       +
         "Last response line received.")

     

       112
       +
       (defvar caledonia--response-flag nil

     

       113
       +
         "Non-nil means a responce has been recieved.")

     

       114
       +
       (defvar-local caledonia--current-query nil

     

       115
       +
         "The current query parameters being displayed in this buffer.")

     

       116
       +
       

     

       117
       +
       ;; API functions

     

       118
       +
       

     

       119
       +
       (defvar caledonia--server-line-buffer "")

     

       120
       +
       

     

       121
       +
       (defun caledonia--server-filter (process output)

     

       122
       +
         "Filter PROCESS OUTPUT."

     

       123
       +
         ;; Append to the ongoing buffer for logging/debugging

     

       124
       +
         (when (buffer-live-p (process-buffer process))

     

       125
       +
           (with-current-buffer (process-buffer process)

     

       126
       +
             (goto-char (point-max))

     

       127
       +
             (insert output)))

     

       128
       +
         ;; Append new output to line buffer

     

       129
       +
         (setq caledonia--server-line-buffer (concat caledonia--server-line-buffer output))

     

       130
       +
         ;; Extract full lines

     

       131
       +
         (let ((lines (split-string caledonia--server-line-buffer "\n")))

     

       132
       +
           ;; Keep the last line (possibly incomplete) for next round

     

       133
       +
           (setq caledonia--server-line-buffer (car (last lines)))

     

       134
       +
           ;; Process all complete lines

     

       135
       +
           (dolist (line (butlast lines))

     

       136
       +
             (when (and (not caledonia--response-flag)

     

       137
       +
                        (not (string-empty-p line)))

     

       138
       +
               (setq caledonia--response-line line)

     

       139
       +
               (setq caledonia--response-flag t)))))

     

       140
       +
       

     

       141
       +
       (defun caledonia--server-sentinel (process event)

     

       142
       +
         "Listen on PROCESS for an EVENT."

     

       143
       +
         (message "Caledonia Server process event: %s (%s)" process event)

     

       144
       +
         (setq caledonia--server-process nil))

     

       145
       +
       

     

       146
       +
       (defun caledonia--ensure-server-running ()

     

       147
       +
         "Run the caledonia binary in server mode."

     

       148
       +
         (unless (and caledonia--server-process (process-live-p caledonia--server-process))

     

       149
       +
           (message "Caledonia  Starting server...")

     

       150
       +
           (setq caledonia--server-process

     

       151
       +
                 (start-process "caledonia-server"

     

       152
       +
                                (get-buffer-create caledonia--server-buffer-name)

     

       153
       +
                                caledonia-executable

     

       154
       +
                                "server"))

     

       155
       +
           (unless (and caledonia--server-process (process-live-p caledonia--server-process))

     

       156
       +
             (error "Caledonia  Failed to start server process"))

     

       157
       +
           (set-process-filter caledonia--server-process #'caledonia--server-filter)

     

       158
       +
           (set-process-sentinel caledonia--server-process #'caledonia--server-sentinel)

     

       159
       +
           (message "Caledonia  Server started.")))

     

       160
       +
       

     

       161
       +
       (defun caledonia--send-request (request-str)

     

       162
       +
         "Send REQUEST-STR and get responce back."

     

       163
       +
         (caledonia--ensure-server-running)

     

       164
       +
         (setq caledonia--response-line nil)

     

       165
       +
         (setq caledonia--response-flag nil)

     

       166
       +
         (process-send-string caledonia--server-process (concat request-str "\n"))

     

       167
       +
         ;; Wait for response

     

       168
       +
         (let ((start-time (current-time)))

     

       169
       +
           (while (and (not caledonia--response-flag)

     

       170
       +
                       (< (time-to-seconds (time-since start-time)) 5) ; 5 sec timeout

     

       171
       +
                       (process-live-p caledonia--server-process))

     

       172
       +
             (accept-process-output caledonia--server-process 0 100000))) ; Wait 100ms

     

       173
       +
         (unless caledonia--response-flag

     

       174
       +
           (error "Caledonia  Timeout or server died waiting for response"))

     

       175
       +
         (condition-case err

     

       176
       +
             (let ((response-sexp (read caledonia--response-line)))

     

       177
       +
               (unless (and (listp response-sexp) (memq (car response-sexp) '(Ok Error)))

     

       178
       +
                 (error "Caledonia  Invalid response format: %S" response-sexp))

     

       179
       +
               (if (eq (car response-sexp) 'Error)

     

       180
       +
                   (error "Caledonia Server Error: %s" (cadr response-sexp))

     

       181
       +
                 ;; Return the (Ok ...) payload

     

       182
       +
                 (cadr response-sexp)))

     

       183
       +
           (error "Caledonia Failed to parse response line: %s"

     

       184
       +
                  caledonia--response-line (error-message-string err))))

     

       185
       +
       

     

       186
       +
       (defun caledonia--get-events (event-payload)

     

       187
       +
         "Parse EVENT-PAYLOAD of structure (Events (events...))."

     

       188
       +
         (if (and (listp event-payload) (eq (car event-payload) 'Events))

     

       189
       +
             (let ((event-list (cadr event-payload)))

     

       190
       +
               event-list)

     

       191
       +
           (error

     

       192
       +
            (message "Failed to parse Caledonia output: %s" (error-message-string err))

     

       193
       +
            nil)))

     

       194
       +
       

     

       195
       +
       ;; UI functions

     

       196
       +
       

     

       197
       +
       (defun caledonia--format-timestamp (iso-string &optional format)

     

       198
       +
         "Format ISO-8601 time string ISO-STRING to human-readable format.

     

       199
       +
       FORMAT defaults to \"%Y-%m-%d %H:%M\" if not specified."

     

       200
       +
         (let* ((parsed (parse-time-string iso-string))

     

       201
       +
                (time (apply #'encode-time

     

       202
       +
                             (append (cl-subseq parsed 0 6) (list nil -1)))))

     

       203
       +
           (format-time-string (or format "%Y-%m-%d %H:%M") time)))

     

       204
       +
       

     

       205
       +
       (defun caledonia--get-key (key event)

     

       206
       +
         "Get KEY from EVENT as a string."

     

       207
       +
         (let ((value (cadr (assoc key event))))

     

       208
       +
           (cond

     

       209
       +
            ((null value) nil)

     

       210
       +
            ((stringp value) value)

     

       211
       +
            ((symbolp value) (symbol-name value)))))

     

       212
       +
       

     

       213
       +
       (defun caledonia--tabulated-list-entries (events)

     

       214
       +
         "Convert EVENTS for a format suitable for showing via a tabulated-list-mode'."

     

       215
       +
         (let ((max-calendar-width 0)

     

       216
       +
               (max-start-width 0)

     

       217
       +
               (max-end-width 0)

     

       218
       +
               (tabulated-list-entries nil))

     

       219
       +
           ;; first pass: calculate maximum widths

     

       220
       +
           (dolist (event events)

     

       221
       +
             (let* ((calendar (caledonia--get-key 'calendar event))

     

       222
       +
                    (start (caledonia--get-key 'start event))

     

       223
       +
                    (end (caledonia--get-key 'end event))

     

       224
       +
                    (cal-str (if (not calendar) "unkown" calendar))

     

       225
       +
                    (start-str (caledonia--format-timestamp start))

     

       226
       +
                    (end-str (when end

     

       227
       +
                               (caledonia--format-timestamp (format "%s" end)))))

     

       228
       +
               (setq max-calendar-width (max max-calendar-width (length cal-str)))

     

       229
       +
               (setq max-start-width (max max-start-width (+ (length start-str) 2)))

     

       230
       +
               (setq max-end-width (max max-end-width (length end-str)))))

     

       231
       +
           (setq caledonia-calendar-column-width  (max max-calendar-width (length "Calendar")))

     

       232
       +
           (setq caledonia-start-column-width (max max-start-width (length "Start")))

     

       233
       +
           (setq caledonia-end-column-width  (max max-end-width (length "End")))

     

       234
       +
           ;; second pass: prepare tabulated-list entries with properties

     

       235
       +
           (setq tabulated-list-entries

     

       236
       +
                 (mapcar (lambda (event)

     

       237
       +
                           (let* (

     

       238
       +
                                  (id (caledonia--get-key 'id event))

     

       239
       +
                                  (summary (caledonia--get-key 'summary event))

     

       240
       +
                                  (start (caledonia--get-key 'start event))

     

       241
       +
                                  (end (caledonia--get-key 'end event))

     

       242
       +
                                  (location (caledonia--get-key 'location event))

     

       243
       +
                                  (calendar (caledonia--get-key 'calendar event))

     

       244
       +
                                  (start-str (caledonia--format-timestamp start))

     

       245
       +
                                  (end-str (if end (caledonia--format-timestamp (format "%s" end)) ""))

     

       246
       +
                                  (start-str (if end (format "%s -" start-str) start-str))

     

       247
       +
                                  (location-str (if location (concat " @ " location) ""))

     

       248
       +
                                  (cal-prop (propertize calendar 'face 'caledonia-calendar-name-face))

     

       249
       +
                                  (start-prop (propertize start-str 'face 'caledonia-date-face))

     

       250
       +
                                  (end-prop (propertize end-str 'face 'caledonia-date-face))

     

       251
       +
                                  (summary-prop (propertize (concat summary location-str)

     

       252
       +
                                                            'face 'caledonia-summary-face))

     

       253
       +
                                  ;; Store the full event data as a text property for retrieval

     

       254
       +
                                  (entry-id (propertize (format "%s" id) 'event-data event)))

     

       255
       +
                             (list entry-id (vector cal-prop start-prop end-prop summary-prop))))

     

       256
       +
                         events))

     

       257
       +
           tabulated-list-entries))

     

       258
       +
       

     

       259
       +
       (defun caledonia--sort-calendar (A B)

     

       260
       +
         "Sort function for calendar column between A and B."

     

       261
       +
         (let ((a (aref (cadr A) 0))

     

       262
       +
               (b (aref (cadr B) 0)))

     

       263
       +
           (string< a b)))

     

       264
       +
       

     

       265
       +
       (defun caledonia--sort-start (A B)

     

       266
       +
         "Sort function for date/time column between A and B."

     

       267
       +
         (let ((a (aref (cadr A) 1))

     

       268
       +
               (b (aref (cadr B) 1)))

     

       269
       +
           (time-less-p (date-to-time a) (date-to-time b))))

     

       270
       +
       

     

       271
       +
       (defun caledonia--sort-end (A B)

     

       272
       +
         "Sort function for date/time column between A and B."

     

       273
       +
         (let ((a (aref (cadr A) 2))

     

       274
       +
               (b (aref (cadr B) 2)))

     

       275
       +
           (time-less-p (date-to-time a) (date-to-time b))))

     

       276
       +
       

     

       277
       +
       (defun caledonia--make-query (&optional query)

     

       278
       +
         "Make a query with the QUERY S-expression.

     

       279
       +
       If QUERY is nil, use the current query stored in `caledonia--current-query`."

     

       280
       +
         (interactive)

     

       281
       +
         (let* ((query-to-use (or query caledonia--current-query '()))  ;; Use current query if available

     

       282
       +
                ;; Ensure to date is set if not present in query

     

       283
       +
                (query-to-use (if (assq 'to query-to-use)

     

       284
       +
                                  query-to-use

     

       285
       +
                                (cons `(to ,caledonia-list-to-date) query-to-use)))

     

       286
       +
                (request-str (format "(Query %s)" (prin1-to-string query-to-use)))

     

       287
       +
                (payload (caledonia--send-request request-str))

     

       288
       +
                (events (caledonia--get-events payload))

     

       289
       +
                (entries (caledonia--tabulated-list-entries events)))

     

       290
       +
           ;; Save this query for future refreshes if explicitly provided

     

       291
       +
           (when query

     

       292
       +
             (setq-local caledonia--current-query query-to-use))

     

       293
       +
           (setq tabulated-list-entries entries))

     

       294
       +
         (setq tabulated-list-format

     

       295
       +
               `[("Calendar" ,caledonia-calendar-column-width caledonia--sort-calendar)

     

       296
       +
                 ("Start" ,caledonia-start-column-width caledonia--sort-start)

     

       297
       +
                 ("End" ,caledonia-end-column-width caledonia--sort-end)

     

       298
       +
                 ("Summary" 0 t)])

     

       299
       +
         (setq tabulated-list-sort-key (cons "Start" nil))

     

       300
       +
         (tabulated-list-init-header)

     

       301
       +
         (tabulated-list-print t))

     

       302
       +
       

     

       303
       +
       (defun caledonia--find-and-highlight-event-in-file (file event-id)

     

       304
       +
         "Find EVENT-ID in FILE, position cursor, and highlight the event.

     

       305
       +
       Return non-nil if the event was found."

     

       306
       +
         (when (and file event-id)

     

       307
       +
           (let ((id-str (format "%s" event-id))

     

       308
       +
                 (found nil))

     

       309
       +
             ;; Try to find and highlight iCalendar VEVENT block

     

       310
       +
             (goto-char (point-min))

     

       311
       +
             (when (and (string-match-p "\\.ics$" file)

     

       312
       +
                        (search-forward (format "UID:%s" id-str) nil t))

     

       313
       +
               ;; Found the UID in an ICS file, try to highlight the VEVENT block

     

       314
       +
               (let ((uid-pos (match-beginning 0))

     

       315
       +
                     (vevent-start nil)

     

       316
       +
                     (vevent-end nil))

     

       317
       +
                 ;; Find start of the VEVENT block

     

       318
       +
                 (save-excursion

     

       319
       +
                   (goto-char uid-pos)

     

       320
       +
                   (if (search-backward "BEGIN:VEVENT" nil t)

     

       321
       +
                       (setq vevent-start (match-beginning 0))

     

       322
       +
                     (setq vevent-start uid-pos)))

     

       323
       +
                 ;; Find end of the VEVENT block

     

       324
       +
                 (save-excursion

     

       325
       +
                   (goto-char uid-pos)

     

       326
       +
                   (if (search-forward "END:VEVENT" nil t)

     

       327
       +
                       (setq vevent-end (match-end 0))

     

       328
       +
                     (setq vevent-end (line-end-position))))

     

       329
       +
                 ;; Highlight the whole VEVENT block if found

     

       330
       +
                 (when (and vevent-start vevent-end)

     

       331
       +
                   (goto-char vevent-start)

     

       332
       +
                   (caledonia--highlight-region vevent-start vevent-end)

     

       333
       +
                   (recenter)

     

       334
       +
                   (setq found t))))

     

       335
       +
             (unless found

     

       336
       +
               (message "Event ID not found in file"))

     

       337
       +
             found)))

     

       338
       +
       

     

       339
       +
       (defun caledonia--display-event-details (event)

     

       340
       +
         "Display details for EVENT in a separate buffer."

     

       341
       +
         (let ((buf (get-buffer-create caledonia--details-buffer)))

     

       342
       +
           (with-current-buffer buf

     

       343
       +
             (let ((inhibit-read-only t))

     

       344
       +
               (erase-buffer)

     

       345
       +
               (special-mode)

     

       346
       +
               (let* ((id (caledonia--get-key 'id event))

     

       347
       +
                      (summary (caledonia--get-key 'summary event))

     

       348
       +
                      (description (caledonia--get-key 'description event))

     

       349
       +
                      (start (caledonia--get-key 'start event))

     

       350
       +
                      (end (caledonia--get-key 'end event))

     

       351
       +
                      (location (caledonia--get-key 'location event))

     

       352
       +
                      (calendar (caledonia--get-key 'calendar event))

     

       353
       +
                      (file (caledonia--get-key 'file event))

     

       354
       +
                      (start-str (when start (caledonia--format-timestamp start)))

     

       355
       +
                      (end-str (when end (caledonia--format-timestamp end))))

     

       356
       +
                 (when id

     

       357
       +
                   (insert (propertize "Summary: " 'face 'bold) summary "\n"))

     

       358
       +
                 (when id

     

       359
       +
                   (insert (propertize "ID: " 'face 'bold) id "\n"))

     

       360
       +
                 (when calendar

     

       361
       +
                   (insert (propertize "Calendar: " 'face 'bold) calendar "\n"))

     

       362
       +
                 (when start-str

     

       363
       +
                   (insert (propertize "Start: " 'face 'bold) start-str "\n"))

     

       364
       +
                 (when end-str

     

       365
       +
                   (insert (propertize "End: " 'face 'bold) end-str "\n"))

     

       366
       +
                 (when location

     

       367
       +
                   (insert (propertize "Location: " 'face 'bold) location "\n"))

     

       368
       +
                 (when file

     

       369
       +
                   (insert (propertize "File: " 'face 'bold)

     

       370
       +
                           (propertize file 'face 'link

     

       371
       +
                                       'mouse-face 'highlight

     

       372
       +
                                       'help-echo "Click to open file with highlighting"

     

       373
       +
                                       'keymap (let ((map (make-sparse-keymap))

     

       374
       +
                                                     (event-copy event))

     

       375
       +
                                                 (define-key map [mouse-1]

     

       376
       +
                                                             (lambda ()

     

       377
       +
                                                               (interactive)

     

       378
       +
                                                               (let ((file-path file)

     

       379
       +
                                                                     (id-val (caledonia--get-key 'id event-copy)))

     

       380
       +
                                                                 (find-file file-path)

     

       381
       +
                                                                 (caledonia--find-and-highlight-event-in-file

     

       382
       +
                                                                  file-path id-val))))

     

       383
       +
                                                 (define-key map (kbd "RET")

     

       384
       +
                                                             (lambda ()

     

       385
       +
                                                               (interactive)

     

       386
       +
                                                               (let ((file-path file)

     

       387
       +
                                                                     (id-val (caledonia--get-key 'id event-copy)))

     

       388
       +
                                                                 (find-file file-path)

     

       389
       +
                                                                 (caledonia--find-and-highlight-event-in-file

     

       390
       +
                                                                  file-path id-val))))

     

       391
       +
                                                 map))

     

       392
       +
                           "\n"))

     

       393
       +
                 (when description

     

       394
       +
                   (insert "\n" (propertize "Description:" 'face 'bold) "\n"

     

       395
       +
                           (propertize "------------" 'face 'bold) "\n"

     

       396
       +
                           description "\n")))))

     

       397
       +
           (switch-to-buffer-other-window buf)))

     

       398
       +
       

     

       399
       +
       (defun caledonia--highlight-region (start end)

     

       400
       +
         "Highlight the region between START and END."

     

       401
       +
         (when (fboundp 'pulse-momentary-highlight-region)

     

       402
       +
           (pulse-momentary-highlight-region start end))

     

       403
       +
         ;; Fallback for when pulse is not available

     

       404
       +
         (unless (fboundp 'pulse-momentary-highlight-region)

     

       405
       +
           (let ((overlay (make-overlay start end)))

     

       406
       +
             (overlay-put overlay 'face 'highlight)

     

       407
       +
             (run-with-timer 0.5 nil (lambda () (delete-overlay overlay))))))

     

       408
       +
       

     

       409
       +
       (defun caledonia--read-date-range ()

     

       410
       +
         "Read a date range from the user with `org-mode' date picker integration.

     

       411
       +
       Returns a cons cell (from-date . to-date).

     

       412
       +
       The from-date can be nil to indicate no start date constraint."

     

       413
       +
         (let (from to)

     

       414
       +
           (setq from

     

       415
       +
                 (if (y-or-n-p "Set a start date? ")

     

       416
       +
                     (org-read-date nil nil nil "From date: " nil nil t)

     

       417
       +
                                               ; empty string differentiates from nil for optional args later on

     

       418
       +
                   ""))

     

       419
       +
           ;; Use org-mode's date picker for To date (must have a value)

     

       420
       +
           (setq to (org-read-date nil nil nil "To date: " nil nil t))

     

       421
       +
           (cons from to)))

     

       422
       +
       

     

       423
       +
       ;; Query parameter modification functions

     

       424
       +
       

     

       425
       +
       (defun caledonia-query-date-range ()

     

       426
       +
         "Set the date range for the current calendar view."

     

       427
       +
         (interactive)

     

       428
       +
         (when (eq major-mode 'caledonia-mode)

     

       429
       +
           (let* ((dates (caledonia--read-date-range))

     

       430
       +
                  (from (car dates))

     

       431
       +
                  (to (cdr dates))

     

       432
       +
                  (current-query caledonia--current-query)

     

       433
       +
                  (new-query (copy-tree current-query)))

     

       434
       +
             ;; Update the query with the new date range

     

       435
       +
             (setq new-query (assq-delete-all 'from new-query))

     

       436
       +
             (setq new-query (assq-delete-all 'to new-query))

     

       437
       +
             (when (and from (not (string-empty-p from)))

     

       438
       +
               (push `(from ,from) new-query))

     

       439
       +
             (when (and to (not (string-empty-p to)))

     

       440
       +
               (push `(to ,to) new-query))

     

       441
       +
             ;; Execute the updated query

     

       442
       +
             (caledonia--make-query new-query))))

     

       443
       +
       

     

       444
       +
       (defun caledonia-query-calendars ()

     

       445
       +
         "Set the calendars to filter by for the current calendar view.

     

       446
       +
       Fetches available calendars from server to allow selection from a list."

     

       447
       +
         (interactive)

     

       448
       +
         (when (eq major-mode 'caledonia-mode)

     

       449
       +
           (let* ((available-calendars

     

       450
       +
                   (caledonia--send-request "ListCalendars"))

     

       451
       +
                  (calendars-list

     

       452
       +
                   (if (and (listp available-calendars)

     

       453
       +
                            (eq (car available-calendars) 'Calendars))

     

       454
       +
                       (cadr available-calendars)

     

       455
       +
                     (progn

     

       456
       +
                       (message "Failed to get calendar list from server")

     

       457
       +
                       nil)))

     

       458
       +
                  ;; Use completing-read-multiple to select from available calendars

     

       459
       +
                  (selected-calendars

     

       460
       +
                   (completing-read-multiple

     

       461
       +
                    "Select calendars (comma-separated, empty for all): "

     

       462
       +
                    ;; Use empty list if no calendars found

     

       463
       +
                    (or calendars-list '())

     

       464
       +
                    nil nil

     

       465
       +
                    (let ((current-calendars (cdr (assq 'calendars caledonia--current-query))))

     

       466
       +
                      (when current-calendars

     

       467
       +
                        (mapconcat #'identity current-calendars ",")))

     

       468
       +
                    'caledonia-calendars-history))

     

       469
       +
                  (calendars (mapcar #'string-trim selected-calendars))

     

       470
       +
                  (current-query caledonia--current-query)

     

       471
       +
                  (new-query (copy-tree current-query)))

     

       472
       +
             ;; Update the query with the new calendars

     

       473
       +
             (setq new-query (assq-delete-all 'calendars new-query))

     

       474
       +
             (when (and calendars (not (null calendars)))

     

       475
       +
               (push `(calendars ,calendars) new-query))

     

       476
       +
             ;; Execute the updated query

     

       477
       +
             (caledonia--make-query new-query))))

     

       478
       +
       

     

       479
       +
       (defun caledonia-query-text ()

     

       480
       +
         "Set the search text for the current calendar view."

     

       481
       +
         (interactive)

     

       482
       +
         (when (eq major-mode 'caledonia-mode)

     

       483
       +
           (let* ((text (read-string "Search text (leave empty for no text search): "

     

       484
       +
                                     nil 'caledonia-text-history))

     

       485
       +
                  (search-in-str (when (and text (not (string-empty-p text)))

     

       486
       +
                                   (read-string "Search in (summary,description,location - leave empty for all): "

     

       487
       +
                                                nil 'caledonia-search-fields-history)))

     

       488
       +
                  (search-in (when (and search-in-str (not (string-empty-p search-in-str)))

     

       489
       +
                               (mapcar (lambda (field)

     

       490
       +
                                         (intern (string-trim field)))

     

       491
       +
                                       (split-string search-in-str "," t))))

     

       492
       +
                  (current-query caledonia--current-query)

     

       493
       +
                  (new-query (copy-tree current-query)))

     

       494
       +
             ;; Update the query with the new text search parameters

     

       495
       +
             (setq new-query (assq-delete-all 'text new-query))

     

       496
       +
             (setq new-query (assq-delete-all 'search_in new-query))

     

       497
       +
             (when (and text (not (string-empty-p text)))

     

       498
       +
               (push `(text ,text) new-query))

     

       499
       +
             (when search-in

     

       500
       +
               (push `(search_in ,search-in) new-query))

     

       501
       +
             ;; Execute the updated query

     

       502
       +
             (caledonia--make-query new-query))))

     

       503
       +
       

     

       504
       +
       (defun caledonia-query-id ()

     

       505
       +
         "Set the event ID to filter by for the current calendar view."

     

       506
       +
         (interactive)

     

       507
       +
         (when (eq major-mode 'caledonia-mode)

     

       508
       +
           (let* ((id (read-string "Event ID (leave empty for all events): "

     

       509
       +
                                   nil 'caledonia-id-history))

     

       510
       +
                  (current-query caledonia--current-query)

     

       511
       +
                  (new-query (copy-tree current-query)))

     

       512
       +
             ;; Update the query with the new ID

     

       513
       +
             (setq new-query (assq-delete-all 'id new-query))

     

       514
       +
             (when (and id (not (string-empty-p id)))

     

       515
       +
               (push `(id ,id) new-query))

     

       516
       +
             ;; Execute the updated query

     

       517
       +
             (caledonia--make-query new-query))))

     

       518
       +
       

     

       519
       +
       (defun caledonia-query-recurring ()

     

       520
       +
         "Set whether to filter by recurring events for the current calendar view."

     

       521
       +
         (interactive)

     

       522
       +
         (when (eq major-mode 'caledonia-mode)

     

       523
       +
           (let* ((recurring (completing-read "Recurring events (yes/no/all, leave empty for all): "

     

       524
       +
                                              '("" "yes" "no") nil nil nil))

     

       525
       +
                  (current-query caledonia--current-query)

     

       526
       +
                  (new-query (copy-tree current-query)))

     

       527
       +
             ;; Update the query with the recurring filter

     

       528
       +
             (setq new-query (assq-delete-all 'recurring new-query))

     

       529
       +
             (when (not (string-empty-p recurring))

     

       530
       +
               (push `(recurring ,(if (string= recurring "yes") t nil)) new-query))

     

       531
       +
             ;; Execute the updated query

     

       532
       +
             (caledonia--make-query new-query))))

     

       533
       +
       

     

       534
       +
       (defun caledonia-query-limit ()

     

       535
       +
         "Set the maximum number of events to show in the current calendar view."

     

       536
       +
         (interactive)

     

       537
       +
         (when (eq major-mode 'caledonia-mode)

     

       538
       +
           (let* ((limit-str (read-string "Maximum events to show (leave empty for no limit): "

     

       539
       +
                                          nil 'caledonia-limit-history))

     

       540
       +
                  (limit (when (and limit-str (not (string-empty-p limit-str)))

     

       541
       +
                           (string-to-number limit-str)))

     

       542
       +
                  (current-query caledonia--current-query)

     

       543
       +
                  (new-query (copy-tree current-query)))

     

       544
       +
             ;; Update the query with the new limit

     

       545
       +
             (setq new-query (assq-delete-all 'limit new-query))

     

       546
       +
             (when limit

     

       547
       +
               (push `(limit ,limit) new-query))

     

       548
       +
             ;; Execute the updated query

     

       549
       +
             (caledonia--make-query new-query))))

     

       550
       +
       

     

       551
       +
       (defun caledonia-query-timezone ()

     

       552
       +
         "Set the timezone for the current calendar view."

     

       553
       +
         (interactive)

     

       554
       +
         (when (eq major-mode 'caledonia-mode)

     

       555
       +
           (let* ((timezone-str (read-string "Timezone (e.g. Europe/London, leave empty for default): "

     

       556
       +
                                             nil 'caledonia-timezone-history))

     

       557
       +
                  (timezone (when (not (string-empty-p timezone-str)) timezone-str))

     

       558
       +
                  (current-query caledonia--current-query)

     

       559
       +
                  (new-query (copy-tree current-query)))

     

       560
       +
             ;; Update the query with the new timezone

     

       561
       +
             (setq new-query (assq-delete-all 'timezone new-query))

     

       562
       +
             (when timezone

     

       563
       +
               (push `(timezone ,timezone) new-query))

     

       564
       +
             ;; Execute the updated query

     

       565
       +
             (caledonia--make-query new-query))))

     

       566
       +
       

     

       567
       +
       ;; Buffer functions

     

       568
       +
       

     

       569
       +
       (defun caledonia-show-event ()

     

       570
       +
         "Show details for the event at point in a separate buffer."

     

       571
       +
         (interactive)

     

       572
       +
         (when (eq major-mode 'caledonia-mode)

     

       573
       +
           (let* ((id (tabulated-list-get-id))

     

       574
       +
                  (event (when id (get-text-property 0 'event-data id))))

     

       575
       +
             (if event

     

       576
       +
                 (caledonia--display-event-details event)

     

       577
       +
               (message "No event at point")))))

     

       578
       +
       

     

       579
       +
       (defun caledonia-open-event-file ()

     

       580
       +
         "Open the file associated with the event at point.

     

       581
       +
       If the file contains the event ID, the cursor will be positioned at that

     

       582
       +
       location."

     

       583
       +
         (interactive)

     

       584
       +
         (when (eq major-mode 'caledonia-mode)

     

       585
       +
           (let* ((id (tabulated-list-get-id))

     

       586
       +
                  (event (when id (get-text-property 0 'event-data id)))

     

       587
       +
                  (file (when event (caledonia--get-key 'file event)))

     

       588
       +
                  (event-id (when event (caledonia--get-key 'id event))))

     

       589
       +
             (cond

     

       590
       +
              ((not event)

     

       591
       +
               (message "No event at point"))

     

       592
       +
              ((not file)

     

       593
       +
               (message "No file associated with this event"))

     

       594
       +
              ((not (file-exists-p file))

     

       595
       +
               (message "File does not exist: %s" file))

     

       596
       +
              (t

     

       597
       +
               (find-file file)

     

       598
       +
               (caledonia--find-and-highlight-event-in-file file event-id))))))

     

       599
       +
       

     

       600
       +
       (defun caledonia-refresh ()

     

       601
       +
         "Refresh calendar data from disk and update the current view.

     

       602
       +
       This is useful when calendar files have been modified outside Emacs."

     

       603
       +
         (interactive)

     

       604
       +
         (when (eq major-mode 'caledonia-mode)

     

       605
       +
           ;; Send a refresh command to clear the server's cache

     

       606
       +
           (caledonia--send-request "Refresh")

     

       607
       +
           ;; Re-apply the current query to update the view

     

       608
       +
           (when (string= (buffer-name) caledonia--events-buffer)

     

       609
       +
             ;; Just use caledonia--make-query without args to use the stored query

     

       610
       +
             (caledonia--make-query))))

     

       611
       +
       

     

       612
       +
       ;; Entry functions

     

       613
       +
       

     

       614
       +
       (defun caledonia-query ()

     

       615
       +
         "Query events with interactive prompts for all filter parameters.

     

       616
       +
       Opens a series of prompts to build a complete query and then displays the

     

       617
       +
       results. After the initial query is displayed, you can further refine the

     

       618
       +
       results using the caledonia-query-* family of functions."

     

       619
       +
         (interactive)

     

       620
       +
         (let* (

     

       621
       +
                (dates (caledonia--read-date-range))

     

       622
       +
                (from (car dates))

     

       623
       +
                (to (cdr dates))

     

       624
       +
                (timezone-str (read-string "Timezone (e.g. Europe/London, leave empty for default): "

     

       625
       +
                                           nil 'caledonia-timezone-history))

     

       626
       +
                (timezone (when (not (string-empty-p timezone-str)) timezone-str))

     

       627
       +
                (available-calendars

     

       628
       +
                 (caledonia--send-request "ListCalendars"))

     

       629
       +
                (calendars-list

     

       630
       +
                 (if (and (listp available-calendars)

     

       631
       +
                          (eq (car available-calendars) 'Calendars))

     

       632
       +
                     (cadr available-calendars)

     

       633
       +
                   (progn

     

       634
       +
                     (message "Failed to get calendar list from server")

     

       635
       +
                     nil)))

     

       636
       +
                (selected-calendars

     

       637
       +
                 (completing-read-multiple

     

       638
       +
                  "Select calendars (comma-separated, empty for all): "

     

       639
       +
                  (or calendars-list '()) nil nil nil 'caledonia-calendars-history))

     

       640
       +
                (calendars (mapcar #'string-trim selected-calendars))

     

       641
       +
                (text (read-string "Search text (leave empty for no text search): "

     

       642
       +
                                   nil 'caledonia-text-history))

     

       643
       +
                (search-in-str (when (and text (not (string-empty-p text)))

     

       644
       +
                                 (read-string "Search in (summary,description,location - leave empty for all): "

     

       645
       +
                                              nil 'caledonia-search-fields-history)))

     

       646
       +
                (search-in (when (and search-in-str (not (string-empty-p search-in-str)))

     

       647
       +
                             (mapcar (lambda (field)

     

       648
       +
                                       (intern (string-trim field)))

     

       649
       +
                                     (split-string search-in-str "," t))))

     

       650
       +
                (id (read-string "Event ID (leave empty for all events): "

     

       651
       +
                                 nil 'caledonia-id-history))

     

       652
       +
                (recurring (completing-read "Recurring events (yes/no/all, leave empty for all): "

     

       653
       +
                                            '("" "yes" "no") nil nil nil))

     

       654
       +
                (limit-str (read-string "Maximum events to show (leave empty for no limit): "

     

       655
       +
                                        nil 'caledonia-limit-history))

     

       656
       +
                (limit (when (and limit-str (not (string-empty-p limit-str)))

     

       657
       +
                         (string-to-number limit-str)))

     

       658
       +
                (query nil))

     

       659
       +
           ;; Build query based on parameters

     

       660
       +
           (when (and from (not (string-empty-p from)))

     

       661
       +
             (push `(from ,from) query))

     

       662
       +
           (when (and to (not (string-empty-p to)))

     

       663
       +
             (push `(to ,to) query))

     

       664
       +
           (when timezone

     

       665
       +
             (push `(timezone ,timezone) query))

     

       666
       +
           (when calendars

     

       667
       +
             (push `(calendars ,calendars) query))

     

       668
       +
           (when (and text (not (string-empty-p text)))

     

       669
       +
             (push `(text ,text) query))

     

       670
       +
           (when search-in

     

       671
       +
             (push `(search_in ,search-in) query))

     

       672
       +
           (when (and id (not (string-empty-p id)))

     

       673
       +
             (push `(id ,id) query))

     

       674
       +
           (when (not (string-empty-p recurring))

     

       675
       +
             (push `(recurring ,(if (string= recurring "yes") t nil)) query))

     

       676
       +
           (when limit

     

       677
       +
             (push `(limit ,limit) query))

     

       678
       +
           ;; Create buffer and execute query

     

       679
       +
           (let ((buffer (get-buffer-create caledonia--events-buffer)))

     

       680
       +
             (with-current-buffer buffer

     

       681
       +
               ;; Clear the buffer and reset it

     

       682
       +
               (let ((inhibit-read-only t))

     

       683
       +
                 (erase-buffer))

     

       684
       +
               ;; Activate our mode and make the query

     

       685
       +
               (caledonia-mode)

     

       686
       +
               (caledonia--make-query query)

     

       687
       +
               (switch-to-buffer buffer)))))

     

       688
       +
       

     

       689
       +
       (defun caledonia-list (&optional from-date to-date)

     

       690
       +
         "List calendar in a new buffer within the default date range.

     

       691
       +
       FROM-DATE and TO-DATE override the default date range if provided. TO-DATE is

     

       692
       +
       required and will use a default if not specified. With prefix arg, prompts for

     

       693
       +
       the date range with an interactive calendar."

     

       694
       +
         (interactive

     

       695
       +
          (when current-prefix-arg

     

       696
       +
            (let* ((dates (caledonia--read-date-range)))

     

       697
       +
              (list (car dates) (cdr dates)))))

     

       698
       +
         (let ((buffer (get-buffer-create caledonia--events-buffer))

     

       699
       +
               (from (or from-date caledonia-list-from-date))

     

       700
       +
               ;; Ensure to date is always provided

     

       701
       +
               (to (or (and to-date (not (string-empty-p to-date)) to-date)

     

       702
       +
                       caledonia-list-to-date)))

     

       703
       +
           (with-current-buffer buffer

     

       704
       +
             ;; Clear the buffer and reset it

     

       705
       +
             (let ((inhibit-read-only t))

     

       706
       +
               (erase-buffer))

     

       707
       +
             ;; Build the query

     

       708
       +
             (let* ((query `((to ,to))))

     

       709
       +
               ;; Add from date only if specified

     

       710
       +
               (when (and from (not (string-empty-p from)))

     

       711
       +
                 (setq query (append query `((from ,from)))))

     

       712
       +
               ;; Activate our mode and make the query

     

       713
       +
               (caledonia-mode)

     

       714
       +
               (caledonia--make-query query)

     

       715
       +
               (switch-to-buffer buffer)))))

     

       716
       +
       

     

       717
       +
       (defun caledonia-search (&optional expr from-date to-date)

     

       718
       +
         "Search for query EXPR with optional FROM-DATE and TO-DATE.

     

       719
       +
       This is an interactive function which asks user for EXPR if not passed as an

     

       720
       +
       argument. With prefix arg, also prompts for date range with an interactive

     

       721
       +
       calendar. Use this to find events matching specific text across all calendars.

     

       722
       +
       TO-DATE is required; a default will be used if not provided."

     

       723
       +
         (interactive

     

       724
       +
          (let* ((search-text (read-string "Search for: " nil 'caledonia-search-prompt-history))

     

       725
       +
                 (dates (when current-prefix-arg (caledonia--read-date-range))))

     

       726
       +
            (list search-text

     

       727
       +
                  (when current-prefix-arg (car dates))

     

       728
       +
                  (when current-prefix-arg (cdr dates)))))

     

       729
       +
         (let ((buffer (get-buffer-create caledonia--events-buffer))

     

       730
       +
               (from (or from-date caledonia-search-from-date))

     

       731
       +
               (to (or to-date caledonia-search-to-date)))

     

       732
       +
           (with-current-buffer buffer

     

       733
       +
             ;; Clear the buffer and reset it

     

       734
       +
             (let ((inhibit-read-only t))

     

       735
       +
               (erase-buffer))

     

       736
       +
             ;; Build the query

     

       737
       +
             (let* ((query `((text ,expr)(to ,to))))

     

       738
       +
               ;; Add from date only if specified

     

       739
       +
               (when (and from (not (string-empty-p from)))

     

       740
       +
                 (setq query (append query `((from ,from)))))

     

       741
       +
               ;; Activate our mode and make the query

     

       742
       +
               (caledonia-mode)

     

       743
       +
               (caledonia--make-query query)

     

       744
       +
               (switch-to-buffer buffer)))))

     

       745
       +
       

     

       746
       +
       ;; Modes

     

       747
       +
       ;;;###autoload

     

       748
       +
       

     

       749
       +
       ;; Create a filter prefix map for query refinement

     

       750
       +
       (defvar caledonia-filter-map

     

       751
       +
         (let ((map (make-sparse-keymap)))

     

       752
       +
           (define-key map (kbd "d") 'caledonia-query-date-range)

     

       753
       +
           (define-key map (kbd "c") 'caledonia-query-calendars)

     

       754
       +
           (define-key map (kbd "t") 'caledonia-query-text)

     

       755
       +
           (define-key map (kbd "i") 'caledonia-query-id)

     

       756
       +
           (define-key map (kbd "r") 'caledonia-query-recurring)

     

       757
       +
           (define-key map (kbd "l") 'caledonia-query-limit)

     

       758
       +
           (define-key map (kbd "z") 'caledonia-query-timezone)

     

       759
       +
           map)

     

       760
       +
         "Keymap for filter commands in Caledonia mode.")

     

       761
       +
       

     

       762
       +
       (defvar caledonia-mode-map

     

       763
       +
         (let ((map (make-sparse-keymap)))

     

       764
       +
           (set-keymap-parent map tabulated-list-mode-map)

     

       765
       +
           (define-key map (kbd "RET") 'caledonia-show-event)

     

       766
       +
           (define-key map (kbd "M-RET") 'caledonia-open-event-file)

     

       767
       +
           (define-key map (kbd "l") 'caledonia-list)

     

       768
       +
           (define-key map (kbd "s") 'caledonia-search)

     

       769
       +
           (define-key map (kbd "r") 'caledonia-refresh)

     

       770
       +
           (define-key map (kbd "q") 'quit-window)

     

       771
       +
           ;; Individual filter command bindings

     

       772
       +
           (define-key map (kbd "C-c d") 'caledonia-query-date-range)

     

       773
       +
           (define-key map (kbd "C-c c") 'caledonia-query-calendars)

     

       774
       +
           (define-key map (kbd "C-c t") 'caledonia-query-text)

     

       775
       +
           (define-key map (kbd "C-c i") 'caledonia-query-id)

     

       776
       +
           (define-key map (kbd "C-c r") 'caledonia-query-recurring)

     

       777
       +
           (define-key map (kbd "C-c l") 'caledonia-query-limit)

     

       778
       +
           (define-key map (kbd "C-c z") 'caledonia-query-timezone)

     

       779
       +
           ;; Use f prefix for filter commands

     

       780
       +
           (define-key map (kbd "C-c f") caledonia-filter-map)

     

       781
       +
           map)

     

       782
       +
         "Keymap for Caledonia mode.")

     

       783
       +
       

     

       784
       +
       (define-derived-mode caledonia-mode tabulated-list-mode "Caledonia"

     

       785
       +
         "Major mode for displaying calendar entries in a tabular view.")

     

       786
       +
       

     

       787
       +
       (provide 'caledonia)

     

       788
       +
       ;;; caledonia.el ends here

+175

flake.lock

···

       1
       +
       {

     

       2
       +
         "nodes": {

     

       3
       +
           "flake-compat": {

     

       4
       +
             "flake": false,

     

       5
       +
             "locked": {

     

       6
       +
               "lastModified": 1696426674,

     

       7
       +
               "narHash": "sha256-kvjfFW7WAETZlt09AgDn1MrtKzP7t90Vf7vypd3OL1U=",

     

       8
       +
               "owner": "edolstra",

     

       9
       +
               "repo": "flake-compat",

     

       10
       +
               "rev": "0f9255e01c2351cc7d116c072cb317785dd33b33",

     

       11
       +
               "type": "github"

     

       12
       +
             },

     

       13
       +
             "original": {

     

       14
       +
               "owner": "edolstra",

     

       15
       +
               "repo": "flake-compat",

     

       16
       +
               "type": "github"

     

       17
       +
             }

     

       18
       +
           },

     

       19
       +
           "flake-utils": {

     

       20
       +
             "inputs": {

     

       21
       +
               "systems": "systems"

     

       22
       +
             },

     

       23
       +
             "locked": {

     

       24
       +
               "lastModified": 1731533236,

     

       25
       +
               "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",

     

       26
       +
               "owner": "numtide",

     

       27
       +
               "repo": "flake-utils",

     

       28
       +
               "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",

     

       29
       +
               "type": "github"

     

       30
       +
             },

     

       31
       +
             "original": {

     

       32
       +
               "owner": "numtide",

     

       33
       +
               "repo": "flake-utils",

     

       34
       +
               "type": "github"

     

       35
       +
             }

     

       36
       +
           },

     

       37
       +
           "mirage-opam-overlays": {

     

       38
       +
             "flake": false,

     

       39
       +
             "locked": {

     

       40
       +
               "lastModified": 1710922379,

     

       41
       +
               "narHash": "sha256-j4QREQDUf8oHOX7qg6wAOupgsNQoYlufxoPrgagD+pY=",

     

       42
       +
               "owner": "dune-universe",

     

       43
       +
               "repo": "mirage-opam-overlays",

     

       44
       +
               "rev": "797cb363df3ff763c43c8fbec5cd44de2878757e",

     

       45
       +
               "type": "github"

     

       46
       +
             },

     

       47
       +
             "original": {

     

       48
       +
               "owner": "dune-universe",

     

       49
       +
               "repo": "mirage-opam-overlays",

     

       50
       +
               "type": "github"

     

       51
       +
             }

     

       52
       +
           },

     

       53
       +
           "nixpkgs": {

     

       54
       +
             "locked": {

     

       55
       +
               "lastModified": 1743761221,

     

       56
       +
               "narHash": "sha256-g79y3RpbyfOlwm3W4yuMXLmmNI7iDgIDqg10nq8pz5U=",

     

       57
       +
               "owner": "nixos",

     

       58
       +
               "repo": "nixpkgs",

     

       59
       +
               "rev": "e1964791d66993a8aa5b9f19c1c6dd5827851355",

     

       60
       +
               "type": "github"

     

       61
       +
             },

     

       62
       +
             "original": {

     

       63
       +
               "owner": "nixos",

     

       64
       +
               "repo": "nixpkgs",

     

       65
       +
               "type": "github"

     

       66
       +
             }

     

       67
       +
           },

     

       68
       +
           "opam-nix": {

     

       69
       +
             "inputs": {

     

       70
       +
               "flake-compat": "flake-compat",

     

       71
       +
               "flake-utils": [

     

       72
       +
                 "flake-utils"

     

       73
       +
               ],

     

       74
       +
               "mirage-opam-overlays": "mirage-opam-overlays",

     

       75
       +
               "nixpkgs": [

     

       76
       +
                 "nixpkgs"

     

       77
       +
               ],

     

       78
       +
               "opam-overlays": "opam-overlays",

     

       79
       +
               "opam-repository": "opam-repository",

     

       80
       +
               "opam2json": "opam2json"

     

       81
       +
             },

     

       82
       +
             "locked": {

     

       83
       +
               "lastModified": 1744376747,

     

       84
       +
               "narHash": "sha256-CKZLqLgZtMrUyZKlroISYp6Z4aoN1N9xeyk0dPNxGvc=",

     

       85
       +
               "owner": "RyanGibb",

     

       86
       +
               "repo": "opam-nix",

     

       87
       +
               "rev": "787eeba962582ff0142f445a74f1edb667d7e941",

     

       88
       +
               "type": "github"

     

       89
       +
             },

     

       90
       +
             "original": {

     

       91
       +
               "owner": "RyanGibb",

     

       92
       +
               "ref": "timere",

     

       93
       +
               "repo": "opam-nix",

     

       94
       +
               "type": "github"

     

       95
       +
             }

     

       96
       +
           },

     

       97
       +
           "opam-overlays": {

     

       98
       +
             "flake": false,

     

       99
       +
             "locked": {

     

       100
       +
               "lastModified": 1726822209,

     

       101
       +
               "narHash": "sha256-bwM18ydNT9fYq91xfn4gmS21q322NYrKwfq0ldG9GYw=",

     

       102
       +
               "owner": "dune-universe",

     

       103
       +
               "repo": "opam-overlays",

     

       104
       +
               "rev": "f2bec38beca4aea9e481f2fd3ee319c519124649",

     

       105
       +
               "type": "github"

     

       106
       +
             },

     

       107
       +
             "original": {

     

       108
       +
               "owner": "dune-universe",

     

       109
       +
               "repo": "opam-overlays",

     

       110
       +
               "type": "github"

     

       111
       +
             }

     

       112
       +
           },

     

       113
       +
           "opam-repository": {

     

       114
       +
             "flake": false,

     

       115
       +
             "locked": {

     

       116
       +
               "lastModified": 1740730647,

     

       117
       +
               "narHash": "sha256-6veU2WjUGcWDAzLDjoAI1L6GWZd0KIUq19sHcbJS+u8=",

     

       118
       +
               "owner": "ocaml",

     

       119
       +
               "repo": "opam-repository",

     

       120
       +
               "rev": "f1f75fef5fbf1e8bd1cc9544e50b89ba59f625e2",

     

       121
       +
               "type": "github"

     

       122
       +
             },

     

       123
       +
             "original": {

     

       124
       +
               "owner": "ocaml",

     

       125
       +
               "repo": "opam-repository",

     

       126
       +
               "type": "github"

     

       127
       +
             }

     

       128
       +
           },

     

       129
       +
           "opam2json": {

     

       130
       +
             "inputs": {

     

       131
       +
               "nixpkgs": [

     

       132
       +
                 "opam-nix",

     

       133
       +
                 "nixpkgs"

     

       134
       +
               ]

     

       135
       +
             },

     

       136
       +
             "locked": {

     

       137
       +
               "lastModified": 1671540003,

     

       138
       +
               "narHash": "sha256-5pXfbUfpVABtKbii6aaI2EdAZTjHJ2QntEf0QD2O5AM=",

     

       139
       +
               "owner": "tweag",

     

       140
       +
               "repo": "opam2json",

     

       141
       +
               "rev": "819d291ea95e271b0e6027679de6abb4d4f7f680",

     

       142
       +
               "type": "github"

     

       143
       +
             },

     

       144
       +
             "original": {

     

       145
       +
               "owner": "tweag",

     

       146
       +
               "repo": "opam2json",

     

       147
       +
               "type": "github"

     

       148
       +
             }

     

       149
       +
           },

     

       150
       +
           "root": {

     

       151
       +
             "inputs": {

     

       152
       +
               "flake-utils": "flake-utils",

     

       153
       +
               "nixpkgs": "nixpkgs",

     

       154
       +
               "opam-nix": "opam-nix"

     

       155
       +
             }

     

       156
       +
           },

     

       157
       +
           "systems": {

     

       158
       +
             "locked": {

     

       159
       +
               "lastModified": 1681028828,

     

       160
       +
               "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",

     

       161
       +
               "owner": "nix-systems",

     

       162
       +
               "repo": "default",

     

       163
       +
               "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",

     

       164
       +
               "type": "github"

     

       165
       +
             },

     

       166
       +
             "original": {

     

       167
       +
               "owner": "nix-systems",

     

       168
       +
               "repo": "default",

     

       169
       +
               "type": "github"

     

       170
       +
             }

     

       171
       +
           }

     

       172
       +
         },

     

       173
       +
         "root": "root",

     

       174
       +
         "version": 7

     

       175
       +
       }

+39

flake.nix

···

       1
       +
       {

     

       2
       +
         inputs = {

     

       3
       +
           nixpkgs.url = "github:nixos/nixpkgs";

     

       4
       +
           opam-nix.url = "github:tweag/opam-nix";

     

       5
       +
           flake-utils.url = "github:numtide/flake-utils";

     

       6
       +
           # we pin opam-nix's nixpkgs to follow the flakes, avoiding using two different instances

     

       7
       +
           opam-nix.inputs.nixpkgs.follows = "nixpkgs";

     

       8
       +
           # deduplicate flakes

     

       9
       +
           opam-nix.inputs.flake-utils.follows = "flake-utils";

     

       10
       +
         };

     

       11
       +
         outputs = { self, nixpkgs, flake-utils, opam-nix, ... }@inputs:

     

       12
       +
           flake-utils.lib.eachDefaultSystem (system:

     

       13
       +
             let

     

       14
       +
               package = "caledonia";

     

       15
       +
               pkgs = nixpkgs.legacyPackages.${system};

     

       16
       +
               opam-nix-lib = opam-nix.lib.${system};

     

       17
       +
               devPackagesQuery = {

     

       18
       +
                 ocaml-lsp-server = "*";

     

       19
       +
                 ocamlformat = "*";

     

       20
       +
                 utop = "*";

     

       21
       +
               };

     

       22
       +
               query = {

     

       23
       +
                 ocaml-base-compiler = "*";

     

       24
       +
               };

     

       25
       +
               scope =

     

       26
       +
                 opam-nix-lib.buildOpamProject' { } ./. (query // devPackagesQuery);

     

       27
       +
             in {

     

       28
       +
               packages.default = scope.${package};

     

       29
       +
               defaultPackage = scope.${package};

     

       30
       +
       

     

       31
       +
               devShells.default = let

     

       32
       +
                 devPackages = builtins.attrValues

     

       33
       +
                   (pkgs.lib.getAttrs (builtins.attrNames devPackagesQuery) scope);

     

       34
       +
               in pkgs.mkShell {

     

       35
       +
                 inputsFrom = [ scope.${package} ];

     

       36
       +
                 buildInputs = devPackages;

     

       37
       +
               };

     

       38
       +
             });

     

       39
       +
       }

+109 -173

lib/calendar_dir.ml

···

       1
        
       open Icalendar

     

       2
        
       

     

       3
       -
       module CollectionMap = Map.Make (struct

     

       4
       -
         type t = Collection.t

     

       5
        
       

     

       6
       -
         let compare (Collection.Col a) (Collection.Col b) = String.compare a b

     

       7
       -
       end)

     

       8
       -
       

     

       9
       -
       type t = { path : string; mutable collections : Event.t list CollectionMap.t }

     

       10
       -
       

     

       11
       -
       let get_collection_path ~fs calendar_dir (Collection.Col collection_name) =

     

       12
       -
         Eio.Path.(fs / calendar_dir.path / collection_name)

     

       13
        
       

     

       14
        
       let ensure_dir path =

     

       15
        
         try

     
···

       22
        
       

     

       23
        
       let create ~fs path =

     

       24
        
         match ensure_dir Eio.Path.(fs / path) with

     

       25
       -
         | Ok () -> Ok { path; collections = CollectionMap.empty }

     

       26
        
         | Error e -> Error e

     

       27
        
       

     

       28
       -
       let list_collections ~fs calendar_dir =

     

       29
        
         try

     

       30
       -
           let dir = Eio.Path.(fs / calendar_dir.path) in

     

       31
       -
           let collections =

     

       32
        
             Eio.Path.read_dir dir

     

       33
        
             |> List.filter_map (fun file ->

     

       34
       -
                    if Eio.Path.is_directory Eio.Path.(dir / file) then

     

       35
       -
                      Some (Collection.Col file)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       36
        
                    else None)

     

       37
       -
             |> List.sort (fun (Collection.Col a) (Collection.Col b) ->

     

       38
       -
                    String.compare a b)

     

       39
        
           in

     

       40
       -
           Ok collections

     

       41
        
         with Eio.Exn.Io _ as exn ->

     

       42
        
           Error

     

       43
        
             (`Msg

     

       44
       -
                (Fmt.str "Failed to list calendar directory %s: %a" calendar_dir.path

     

       45
        
                   Eio.Exn.pp exn))

     

       46
        
       

     

       47
       -
       let load_events collection collection_path file_name =

     

       48
       -
         let file = Eio.Path.(collection_path / file_name) in

     

       49
       -
         let _, file_path = file in

     

       50
       -
         match Filename.check_suffix file_name ".ics" with

     

       51
       -
         | false ->

     

       52
       -
             Printf.eprintf "Skipping non ics file %s\n%!" file_path;

     

       53
       -
             []

     

       54
       -
         | true -> (

     

       55
       -
             try

     

       56
       -
               let content = Eio.Path.load file in

     

       57
       -
               match parse content with

     

       58
       -
               | Ok calendar ->

     

       59
       -
                   let events =

     

       60
       -
                     List.filter_map

     

       61
       -
                       (function

     

       62
       -
                         | `Event e ->

     

       63
       -
                             Some (Event.of_icalendar collection ~file_name e)

     

       64
       -
                         | _ -> None)

     

       65
       -
                       (snd calendar)

     

       66
       -
                   in

     

       67
       -
                   events

     

       68
       -
               | Error err ->

     

       69
       -
                   Printf.eprintf "Failed to parse %s: %s\n%!" file_path err;

     

       70
       -
                   []

     

       71
       -
             with Eio.Exn.Io _ as exn ->

     

       72
       -
               Fmt.epr "Failed to read file %s: %a\n%!" file_path Eio.Exn.pp exn;

     

       73
       -
               [])

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       74
        
       

     

       75
       -
       let get_collection ~fs calendar_dir collection =

     

       76
       -
         match CollectionMap.find_opt collection calendar_dir.collections with

     

       77
       -
         | Some events -> Ok events

     

       78
       -
         | None -> (

     

       79
       -
             let collection_path = get_collection_path ~fs calendar_dir collection in

     

       80
       -
             if not (Eio.Path.is_directory collection_path) then Error `Not_found

     

       81
       -
             else

     

       82
       -
               try

     

       83
       -
                 let files = Eio.Path.read_dir collection_path in

     

       84
       -
                 let events =

     

       85
       -
                   List.flatten

     

       86
       -
                   @@ List.map (load_events collection collection_path) files

     

       87
       -
                 in

     

       88
       -
                 calendar_dir.collections <-

     

       89
       -
                   CollectionMap.add collection events calendar_dir.collections;

     

       90
       -
                 Ok events

     

       91
       -
               with e ->

     

       92
       -
                 Error

     

       93
       -
                   (`Msg

     

       94
       -
                      (Printf.sprintf "Exception processing directory %s: %s"

     

       95
       -
                         (snd collection_path) (Printexc.to_string e))))

     

       96
        
       

     

       97
       -
       let get_collections ~fs calendar_dir =

     

       98
       -
         match list_collections ~fs calendar_dir with

     

       99
        
         | Error e -> Error e

     

       100
        
         | Ok ids -> (

     

       101
        
             try

     

       102
        
               let rec process_ids acc = function

     

       103
        
                 | [] -> Ok (List.rev acc)

     

       104
        
                 | id :: rest -> (

     

       105
       -
                     match get_collection ~fs calendar_dir id with

     

       106
       -
                     | Ok cal -> process_ids ((id, cal) :: acc) rest

     

       107
        
                     | Error `Not_found -> process_ids acc rest

     

       108
        
                     | Error (`Msg e) -> Error (`Msg e))

     

       109
        
               in

     

       110
       -
               process_ids [] ids

     

       0
        
       
     

       111
        
             with exn ->

     

       112
        
               Error

     

       113
        
                 (`Msg

     

       114
       -
                    (Printf.sprintf "Error getting collections: %s"

     

       115
        
                       (Printexc.to_string exn))))

     

       116
        
       

     

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

     

       118
       -
       

     

       119
       -
       let add_event ~fs calendar_dir event =

     

       120
       -
         let collection = Event.get_collection event in

     

       121
       -
         let file_path =

     

       122
       -
           Event.get_file_path ~fs ~calendar_dir_path:calendar_dir.path event

     

       123
       -
         in

     

       124
       -
         let ical_event = Event.to_icalendar event in

     

       125
       -
         let collection_path = get_collection_path ~fs calendar_dir collection in

     

       126
       -
         let ( let* ) = Result.bind in

     

       127
       -
         let* () = ensure_dir collection_path in

     

       128
       -
         let calendar =

     

       129
       -
           let props = [ default_prodid ] in

     

       130
       -
           let components = [ `Event ical_event ] in

     

       131
       -
           (props, components)

     

       132
       -
         in

     

       133
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       134
       -
         let* _ =

     

       135
        
           try

     

       136
       -
             Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;

     

       137
       -
             Ok ()

     

       138
        
           with Eio.Exn.Io _ as exn ->

     

       139
        
             Error

     

       140
        
               (`Msg

     

       141
       -
                  (Fmt.str "Failed to write file %s: %a\n%!" (snd file_path) Eio.Exn.pp

     

       142
       -
                     exn))

     

       143
       -
         in

     

       144
       -
         calendar_dir.collections <-

     

       145
       -
           CollectionMap.add collection

     

       146
       -
             (event

     

       147
       -
             ::

     

       148
       -
             (match CollectionMap.find_opt collection calendar_dir.collections with

     

       149
       -
             | Some lst -> lst

     

       150
       -
             | None -> []))

     

       151
       -
             calendar_dir.collections;

     

       152
       -
         Ok ()

     

       153
        
       

     

       154
       -
       let load_calendar path =

     

       155
       -
         try

     

       156
       -
           let file_content = Eio.Path.load path in

     

       157
       -
           match Icalendar.parse file_content with

     

       158
       -
           | Ok calendar -> Ok calendar

     

       159
       -
           | Error msg -> Error (`Msg msg)

     

       160
       -
         with Eio.Exn.Io _ as exn ->

     

       161
       -
           Error

     

       162
       -
             (`Msg (Fmt.str "Failed to read file %s: %a\n%!" (snd path) Eio.Exn.pp exn))

     

       163
       -
       

     

       164
       -
       let edit_event ~fs calendar_dir event =

     

       165
       -
         let collection = Event.get_collection event in

     

       166
        
         let event_id = Event.get_id event in

     

       167
       -
         let collection_path = get_collection_path ~fs calendar_dir collection in

     

       168
       -
         let ( let* ) = Result.bind in

     

       169
       -
         let* () = ensure_dir collection_path in

     

       170
       -
         let ical_event = Event.to_icalendar event in

     

       171
       -
         let file_path =

     

       172
       -
           Event.get_file_path ~fs ~calendar_dir_path:calendar_dir.path event

     

       173
       -
         in

     

       174
       -
         let* existing_props, existing_components = load_calendar file_path in

     

       175
        
         let calendar =

     

       176
        
           (* Replace the event with our updated version *)

     

       177
        
           let filtered_components =

     
···

       187
        
           (existing_props, `Event ical_event :: filtered_components)

     

       188
        
         in

     

       189
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       190
       -
         let* _ =

     

       191
       -
           try

     

       192
       -
             Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;

     

       193
       -
             Ok ()

     

       194
       -
           with Eio.Exn.Io _ as exn ->

     

       195
       -
             Error

     

       196
       -
               (`Msg

     

       197
       -
                  (Fmt.str "Failed to write file %s: %a\n%!" (snd file_path) Eio.Exn.pp

     

       198
       -
                     exn))

     

       199
       -
         in

     

       200
       -
         calendar_dir.collections <-

     

       201
       -
           CollectionMap.add collection

     

       202
       -
             (event

     

       203
       -
             ::

     

       204
       -
             (match CollectionMap.find_opt collection calendar_dir.collections with

     

       205
       -
             (* filter old version *)

     

       206
       -
             | Some lst -> List.filter (fun e -> Event.get_id e = event_id) lst

     

       207
       -
             | None -> []))

     

       208
       -
             calendar_dir.collections;

     

       209
       -
         Ok ()

     

       210
        
       

     

       211
       -
       let delete_event ~fs calendar_dir event =

     

       212
       -
         let collection = Event.get_collection event in

     

       213
        
         let event_id = Event.get_id event in

     

       214
       -
         let collection_path = get_collection_path ~fs calendar_dir collection in

     

       215
       -
         let ( let* ) = Result.bind in

     

       216
       -
         let* () = ensure_dir collection_path in

     

       217
       -
         let file_path =

     

       218
       -
           Event.get_file_path ~fs ~calendar_dir_path:calendar_dir.path event

     

       219
       -
         in

     

       220
       -
         let* existing_props, existing_components = load_calendar file_path in

     

       221
        
         let other_events = ref false in

     

       222
        
         let calendar =

     

       223
        
           (* Replace the event with our updated version *)

     
···

       237
        
           (existing_props, filtered_components)

     

       238
        
         in

     

       239
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       240
       -
         let* _ =

     

       241
       -
           try

     

       242
       -
             (match !other_events with

     

       243
       -
             | true -> Eio.Path.save ~create:(`Or_truncate 0o644) file_path content

     

       244
       -
             | false -> Eio.Path.unlink file_path);

     

       245
       -
             Ok ()

     

       246
       -
           with Eio.Exn.Io _ as exn ->

     

       247
       -
             Error

     

       248
       -
               (`Msg

     

       249
       -
                  (Fmt.str "Failed to write file %s: %a\n%!" (snd file_path) Eio.Exn.pp

     

       250
       -
                     exn))

     

       251
       -
         in

     

       252
       -
         calendar_dir.collections <-

     

       253
       -
           CollectionMap.add collection

     

       254
       -
             (match CollectionMap.find_opt collection calendar_dir.collections with

     

       255
       -
             (* filter old version *)

     

       256
       -
             | Some lst -> List.filter (fun e -> Event.get_id e = event_id) lst

     

       257
       -
             | None -> [])

     

       258
       -
             calendar_dir.collections;

     

       259
       -
         Ok ()

···

       1
        
       open Icalendar

     

       2
        
       

     

       3
       +
       type t = string

     

       0
        
       
     

       4
        
       

     

       5
       +
       let get_calendar_path ~fs calendar_dir calendar_name_name =

     

       6
       +
         Eio.Path.(fs / calendar_dir / calendar_name_name)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       7
        
       

     

       8
        
       let ensure_dir path =

     

       9
        
         try

     
···

       16
        
       

     

       17
        
       let create ~fs path =

     

       18
        
         match ensure_dir Eio.Path.(fs / path) with

     

       19
       +
         | Ok () -> Ok path

     

       20
        
         | Error e -> Error e

     

       21
        
       

     

       22
       +
       let list_calendar_names ~fs calendar_dir =

     

       23
        
         try

     

       24
       +
           let dir = Eio.Path.(fs / calendar_dir) in

     

       25
       +
           let calendar_names =

     

       26
        
             Eio.Path.read_dir dir

     

       27
        
             |> List.filter_map (fun file ->

     

       28
       +
                    if

     

       29
       +
                      String.length file > 0

     

       30
       +
                      && file.[0] != '.'

     

       31
       +
                      && Eio.Path.is_directory Eio.Path.(dir / file)

     

       32
       +
                    then Some file

     

       33
        
                    else None)

     

       34
       +
             |> List.sort (fun a b -> String.compare a b)

     

       0
        
       
     

       35
        
           in

     

       36
       +
           Ok calendar_names

     

       37
        
         with Eio.Exn.Io _ as exn ->

     

       38
        
           Error

     

       39
        
             (`Msg

     

       40
       +
                (Fmt.str "Failed to list calendar directory %s: %a" calendar_dir

     

       41
        
                   Eio.Exn.pp exn))

     

       42
        
       

     

       43
       +
       let rec load_events_recursive calendar_name dir_path =

     

       44
       +
         try

     

       45
       +
           Eio.Path.read_dir dir_path

     

       46
       +
           |> List.fold_left

     

       47
       +
                (fun acc name ->

     

       48
       +
                  let path = Eio.Path.(dir_path / name) in

     

       49
       +
                  if Eio.Path.is_directory path then

     

       50
       +
                    acc @ load_events_recursive calendar_name path

     

       51
       +
                  else if Filename.check_suffix name ".ics" then (

     

       52
       +
                    try

     

       53
       +
                      let content = Eio.Path.load path in

     

       54
       +
                      match parse content with

     

       55
       +
                      | Ok calendar ->

     

       56
       +
                          acc

     

       57
       +
                          @ Event.events_of_icalendar ~file:path calendar_name calendar

     

       58
       +
                      | Error err ->

     

       59
       +
                          Printf.eprintf "Failed to parse %s: %s\n%!" (snd path) err;

     

       60
       +
                          acc

     

       61
       +
                    with Eio.Exn.Io _ as exn ->

     

       62
       +
                      Fmt.epr "Failed to read file %s: %a\n%!" (snd path) Eio.Exn.pp

     

       63
       +
                        exn;

     

       64
       +
                      acc)

     

       65
       +
                  else acc)

     

       66
       +
                []

     

       67
       +
         with Eio.Exn.Io _ as exn ->

     

       68
       +
           Fmt.epr "Failed to read directory %s: %a\n%!" (snd dir_path) Eio.Exn.pp exn;

     

       69
       +
           []

     

       70
       +
       

     

       71
       +
       let get_calendar_events ~fs calendar_dir calendar_name =

     

       72
       +
         let calendar_name_path =

     

       73
       +
           get_calendar_path ~fs calendar_dir calendar_name

     

       74
       +
         in

     

       75
       +
         if not (Eio.Path.is_directory calendar_name_path) then Error `Not_found

     

       76
       +
         else

     

       77
       +
           try

     

       78
       +
             let events = load_events_recursive calendar_name calendar_name_path in

     

       79
       +
             Ok events

     

       80
       +
           with e ->

     

       81
       +
             Error

     

       82
       +
               (`Msg

     

       83
       +
                  (Printf.sprintf "Exception processing directory %s: %s"

     

       84
       +
                     (snd calendar_name_path) (Printexc.to_string e)))

     

       85
        
       

     

       86
       +
       let ( let* ) = Result.bind

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       87
        
       

     

       88
       +
       let get_events ~fs calendar_dir =

     

       89
       +
         match list_calendar_names ~fs calendar_dir with

     

       90
        
         | Error e -> Error e

     

       91
        
         | Ok ids -> (

     

       92
        
             try

     

       93
        
               let rec process_ids acc = function

     

       94
        
                 | [] -> Ok (List.rev acc)

     

       95
        
                 | id :: rest -> (

     

       96
       +
                     match get_calendar_events ~fs calendar_dir id with

     

       97
       +
                     | Ok cal -> process_ids (cal :: acc) rest

     

       98
        
                     | Error `Not_found -> process_ids acc rest

     

       99
        
                     | Error (`Msg e) -> Error (`Msg e))

     

       100
        
               in

     

       101
       +
               let* calendar_names = process_ids [] ids in

     

       102
       +
               Ok (List.flatten calendar_names)

     

       103
        
             with exn ->

     

       104
        
               Error

     

       105
        
                 (`Msg

     

       106
       +
                    (Printf.sprintf "Error getting calendar_names: %s"

     

       107
        
                       (Printexc.to_string exn))))

     

       108
        
       

     

       109
       +
       let add_event ~fs calendar_dir events event =

     

       110
       +
         let calendar_name = Event.get_calendar_name event in

     

       111
       +
         let file = Event.get_file event in

     

       112
       +
         let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in

     

       113
       +
         let* () = ensure_dir calendar_name_path in

     

       114
       +
         let calendar = Event.to_ical_calendar event in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       115
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       0
        
       
     

       116
        
           try

     

       117
       +
             Eio.Path.save ~create:(`Or_truncate 0o644) file content;

     

       118
       +
             Ok (event :: events)

     

       119
        
           with Eio.Exn.Io _ as exn ->

     

       120
        
             Error

     

       121
        
               (`Msg

     

       122
       +
                  (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       123
        
       

     

       124
       +
       let edit_event ~fs calendar_dir events event =

     

       125
       +
         let calendar_name = Event.get_calendar_name event in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       126
        
         let event_id = Event.get_id event in

     

       127
       +
         let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in

     

       128
       +
         let* () = ensure_dir calendar_name_path in

     

       129
       +
         let ical_event = Event.to_ical_event event in

     

       130
       +
         let file = Event.get_file event in

     

       131
       +
         let existing_props, existing_components = Event.to_ical_calendar event in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       132
        
         let calendar =

     

       133
        
           (* Replace the event with our updated version *)

     

       134
        
           let filtered_components =

     
···

       144
        
           (existing_props, `Event ical_event :: filtered_components)

     

       145
        
         in

     

       146
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       147
       +
         try

     

       148
       +
           Eio.Path.save ~create:(`Or_truncate 0o644) file content;

     

       149
       +
           (* Filter out the old event and add the updated one *)

     

       150
       +
           let filtered_events = List.filter (fun e -> Event.get_id e <> event_id) events in

     

       151
       +
           Ok (event :: filtered_events)

     

       152
       +
         with Eio.Exn.Io _ as exn ->

     

       153
       +
           Error

     

       154
       +
             (`Msg

     

       155
       +
                (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       156
        
       

     

       157
       +
       let delete_event ~fs calendar_dir events event =

     

       158
       +
         let calendar_name = Event.get_calendar_name event in

     

       159
        
         let event_id = Event.get_id event in

     

       160
       +
         let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in

     

       161
       +
         let* () = ensure_dir calendar_name_path in

     

       162
       +
         let file = Event.get_file event in

     

       163
       +
         let existing_props, existing_components = Event.to_ical_calendar event in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       164
        
         let other_events = ref false in

     

       165
        
         let calendar =

     

       166
        
           (* Replace the event with our updated version *)

     
···

       180
        
           (existing_props, filtered_components)

     

       181
        
         in

     

       182
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       183
       +
         try

     

       184
       +
           (match !other_events with

     

       185
       +
           | true -> Eio.Path.save ~create:(`Or_truncate 0o644) file content

     

       186
       +
           | false -> Eio.Path.unlink file);

     

       187
       +
           (* Filter out the deleted event from the events list *)

     

       188
       +
           let filtered_events = List.filter (fun e -> Event.get_id e <> event_id) events in

     

       189
       +
           Ok filtered_events

     

       190
       +
         with Eio.Exn.Io _ as exn ->

     

       191
       +
           Error

     

       192
       +
             (`Msg

     

       193
       +
                (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       194
       +
       

     

       195
       +
       let get_path t = t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+33 -27

lib/calendar_dir.mli

···

       1
       -
       (** Functions for managing calendar directories with Collection.ts of .ics files

     

       2
       -
       *)

     

       3
        
       

     

       4
        
       type t

     

       5
       -
       (** A directory of Collection.ts, where each collection is a subdirectory

     

       6
        
           containing .ics files *)

     

       7
        
       

     

       8
        
       val create :

     

       9
       -
         fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> (t, [> `Msg of string ]) result

     

       10
        
       (** Create a calendar_dir from a directory path. Returns Ok with the

     

       11
        
           calendar_dir if successful, or Error with a message if the directory cannot

     

       12
        
           be created or accessed. *)

     

       13
        
       

     

       14
       -
       val list_collections :

     

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

     

       16
       -
         t ->

     

       17
       -
         (Collection.t list, [> `Msg of string ]) result

     

       18
       -
       (** List available Collection.ts in the calendar_dir. Returns Ok with the list

     

       19
       -
           of Collection.t names if successful, or Error with a message if the

     

       20
       -
           directory cannot be read. *)

     

       21
        
       

     

       22
       -
       val get_collection :

     

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

     

       24
        
         t ->

     

       25
       -
         Collection.t ->

     

       26
        
         (Event.t list, [> `Msg of string | `Not_found ]) result

     

       27
       -
       (** Get all calendar files in a Collection.t. If the collection doesn't exist in

     

       28
        
           the cache, it will be loaded from disk. *)

     

       29
        
       

     

       30
       -
       val get_collections :

     

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

     

       32
       -
         t ->

     

       33
       -
         ((Collection.t * Event.t list) list, [> `Msg of string ]) result

     

       34
       -
       (** Get all Collection.ts with their calendar files. This will load any

     

       35
       -
           Collection.ts that haven't been loaded yet. *)

     

       36
        
       

     

       37
        
       val add_event :

     

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

     

       39
        
         t ->

     

       0
        
       
     

       40
        
         Event.t ->

     

       41
       -
         (unit, [> `Msg of string ]) result

     

       0
        
       
     

       0
        
       
     

       42
        
       

     

       43
        
       val edit_event :

     

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

     

       45
        
         t ->

     

       0
        
       
     

       46
        
         Event.t ->

     

       47
       -
         (unit, [> `Msg of string ]) result

     

       0
        
       
     

       0
        
       
     

       48
        
       

     

       49
        
       val delete_event :

     

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

     

       51
        
         t ->

     

       0
        
       
     

       52
        
         Event.t ->

     

       53
       -
         (unit, [> `Msg of string ]) result

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
       +
       (** Functions for managing calendar directories with strings of .ics files *)

     

       0
        
       
     

       2
        
       

     

       3
        
       type t

     

       4
       +
       (** A directory of strings, where each calendar_name is a subdirectory

     

       5
        
           containing .ics files *)

     

       6
        
       

     

       7
        
       val create :

     

       8
       +
         fs:Eio.Fs.dir_ty Eio.Path.t -> string -> (t, [> `Msg of string ]) result

     

       9
        
       (** Create a calendar_dir from a directory path. Returns Ok with the

     

       10
        
           calendar_dir if successful, or Error with a message if the directory cannot

     

       11
        
           be created or accessed. *)

     

       12
        
       

     

       13
       +
       val list_calendar_names :

     

       14
       +
         fs:Eio.Fs.dir_ty Eio.Path.t -> t -> (string list, [> `Msg of string ]) result

     

       15
       +
       (** List available strings in the calendar_dir. Returns Ok with the list of

     

       16
       +
           string names if successful, or Error with a message if the directory cannot

     

       17
       +
           be read. *)

     

       0
        
       
     

       0
        
       
     

       18
        
       

     

       19
       +
       val get_calendar_events :

     

       20
       +
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       21
        
         t ->

     

       22
       +
         string ->

     

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

     

       24
       +
       (** Get all calendar files in a string. If the calendar_name doesn't exist in

     

       25
        
           the cache, it will be loaded from disk. *)

     

       26
        
       

     

       27
       +
       val get_events :

     

       28
       +
         fs:Eio.Fs.dir_ty Eio.Path.t -> t -> (Event.t list, [> `Msg of string ]) result

     

       29
       +
       (** Get all events in all calendar_names. This will load any strings that

     

       30
       +
           haven't been loaded yet. *)

     

       0
        
       
     

       0
        
       
     

       31
        
       

     

       32
        
       val add_event :

     

       33
       +
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       34
        
         t ->

     

       35
       +
         Event.t list ->

     

       36
        
         Event.t ->

     

       37
       +
         (Event.t list, [> `Msg of string ]) result

     

       38
       +
       (** Add an event to the calendar directory. Takes the current events list and returns

     

       39
       +
           an updated events list with the new event added. *)

     

       40
        
       

     

       41
        
       val edit_event :

     

       42
       +
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       43
        
         t ->

     

       44
       +
         Event.t list ->

     

       45
        
         Event.t ->

     

       46
       +
         (Event.t list, [> `Msg of string ]) result

     

       47
       +
       (** Edit an event in the calendar directory. Takes the current events list and returns

     

       48
       +
           an updated events list with the event updated. *)

     

       49
        
       

     

       50
        
       val delete_event :

     

       51
       +
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       52
        
         t ->

     

       53
       +
         Event.t list ->

     

       54
        
         Event.t ->

     

       55
       +
         (Event.t list, [> `Msg of string ]) result

     

       56
       +
       (** Delete an event from the calendar directory. Takes the current events list and returns

     

       57
       +
           an updated events list with the event removed. *)

     

       58
       +
       

     

       59
       +
       val get_path : t -> string

-1

lib/collection.ml

···

       1
       -
       type t = Col of string

···

       0

-3

lib/collection.mli

···

       1
       -
       (** A collection is a directory of `ics` files *)

     

       2
       -
       

     

       3
       -
       type t = Col of string  (** The name of the collection. *)

+282 -115

lib/date.ml

···

       1
        
       open Result

     

       2
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       3
        
       let timedesc_to_ptime dt =

     

       4
       -
         match Timedesc.to_timestamp_single dt |> Timedesc.Utils.ptime_of_timestamp with

     

       0
        
       
     

       0
        
       
     

       5
        
         | Some t -> t

     

       6
        
         | None -> failwith "Invalid date conversion from Timedesc to Ptime"

     

       7
        
       

     

       8
       -
       let ptime_to_timedesc ptime =

     

       9
        
         let ts = Timedesc.Utils.timestamp_of_ptime ptime in

     

       10
       -
         match Timedesc.of_timestamp ts with

     

       11
        
         | Some dt -> dt

     

       12
        
         | None -> failwith "Invalid date conversion from Ptime to Timedesc"

     

       13
        
       

     

       14
        
       let get_today =

     

       15
       -
         ref (fun () ->

     

       16
       -
             let now = Timedesc.now () in

     

       17
        
             let date = Timedesc.date now in

     

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

     

       19
       -
             let dt = Timedesc.of_date_and_time_exn date midnight in

     

       20
        
             timedesc_to_ptime dt)

     

       21
        
       

     

       22
        
       (* Convert a midnight timestamp to end-of-day (23:59:59) *)

     

       23
        
       let to_end_of_day date =

     

       24
        
         let dt = ptime_to_timedesc date in

     

       25
        
         let date = Timedesc.date dt in

     

       26
       -
         let end_of_day_time = Timedesc.Time.make_exn ~hour:23 ~minute:59 ~second:59 () in

     

       0
        
       
     

       0
        
       
     

       27
        
         let end_of_day = Timedesc.of_date_and_time_exn date end_of_day_time in

     

       28
        
         timedesc_to_ptime end_of_day

     

       29
        
       

     
···

       35
        
         let new_dt = Timedesc.of_date_and_time_exn new_date time in

     

       36
        
         timedesc_to_ptime new_dt

     

       37
        
       

     

       38
       -
       let add_weeks date weeks =

     

       39
       -
         add_days date (weeks * 7)

     

       40
        
       

     

       41
        
       let add_months date months =

     

       42
        
         let dt = ptime_to_timedesc date in

     
···

       44
        
         let year = Timedesc.Ym.year old_ym in

     

       45
        
         let month = Timedesc.Ym.month old_ym in

     

       46
        
         let day = Timedesc.day dt in

     

       47
       -
         

     

       48
        
         (* Calculate new year and month *)

     

       49
        
         let total_month = (year * 12) + month - 1 + months in

     

       50
        
         let new_year = total_month / 12 in

     

       51
        
         let new_month = (total_month mod 12) + 1 in

     

       52
       -
         

     

       53
        
         (* Try to create new date, handling end of month cases properly *)

     

       54
        
         let rec adjust_day d =

     

       55
        
           match Timedesc.Date.Ymd.make ~year:new_year ~month:new_month ~day:d with

     

       56
       -
           | Ok new_date -> 

     

       57
        
               let time = Timedesc.time dt in

     

       58
        
               let new_dt = Timedesc.of_date_and_time_exn new_date time in

     

       59
        
               timedesc_to_ptime new_dt

     

       60
       -
           | Error _ -> 

     

       61
        
               if d > 1 then adjust_day (d - 1)

     

       62
        
               else failwith "Invalid date after adding months"

     

       63
        
         in

     

       64
        
         adjust_day day

     

       65
        
       

     

       66
       -
       let add_years date years =

     

       67
       -
         add_months date (years * 12)

     

       68
        
       

     

       69
        
       let get_start_of_week date =

     

       70
        
         let dt = ptime_to_timedesc date in

     
···

       79
        
           | `Sat -> 5

     

       80
        
           | `Sun -> 6

     

       81
        
         in

     

       82
       -
         let monday_date = Timedesc.Date.sub ~days:days_to_subtract (Timedesc.date dt) in

     

       0
        
       
     

       0
        
       
     

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

     

       84
       -
         let monday_with_midnight = Timedesc.of_date_and_time_exn monday_date midnight in

     

       0
        
       
     

       0
        
       
     

       85
        
         timedesc_to_ptime monday_with_midnight

     

       86
        
       

     

       87
       -
       let get_start_of_current_week () = get_start_of_week (!get_today ())

     

       88
       -
       let get_start_of_next_week () = add_days (get_start_of_current_week ()) 7

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       89
        
       let get_end_of_week date = add_days (get_start_of_week date) 6

     

       90
       -
       let get_end_of_current_week () = get_end_of_week (!get_today ())

     

       91
       -
       let get_end_of_next_week () = get_end_of_week (get_start_of_next_week ())

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       92
        
       

     

       93
        
       let get_start_of_month date =

     

       94
        
         let dt = ptime_to_timedesc date in

     

       95
        
         let year = Timedesc.year dt in

     

       96
        
         let month = Timedesc.month dt in

     

       97
       -
         

     

       98
        
         (* Create a date for the first of the month *)

     

       99
        
         match Timedesc.Date.Ymd.make ~year ~month ~day:1 with

     

       100
        
         | Ok first_day ->

     
···

       103
        
             timedesc_to_ptime first_of_month

     

       104
        
         | Error _ -> failwith "Invalid date for start of month"

     

       105
        
       

     

       106
       -
       let get_start_of_current_month () = get_start_of_month (!get_today ())

     

       107
       -
       let get_start_of_next_month () = add_months (get_start_of_current_month ()) 1

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       108
        
       

     

       109
        
       let get_end_of_month date =

     

       110
        
         let dt = ptime_to_timedesc date in

     

       111
        
         let year = Timedesc.year dt in

     

       112
        
         let month = Timedesc.month dt in

     

       113
       -
         

     

       114
        
         (* Determine next month and year *)

     

       115
        
         let next_month_int = if month == 12 then 1 else month + 1 in

     

       116
        
         let next_month_year = if month == 12 then year + 1 else year in

     

       117
       -
         

     

       118
        
         (* Create a date for the first of next month *)

     

       119
       -
         match Timedesc.Date.Ymd.make ~year:next_month_year ~month:next_month_int ~day:1 with

     

       120
       -
         | Ok first_of_next_month ->

     

       0
        
       
     

       0
        
       
     

       121
        
             (* Create the timestamp and subtract 1 second *)

     

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

     

       123
       -
             let first_of_next_month_dt = Timedesc.of_date_and_time_exn first_of_next_month midnight in

     

       0
        
       
     

       0
        
       
     

       124
        
             let one_second = Timedesc.Span.For_human.make_exn ~seconds:1 () in

     

       125
       -
             let end_of_month_ts = 

     

       126
        
               match Timedesc.to_timestamp first_of_next_month_dt with

     

       127
        
               | `Single ts -> Timedesc.Span.sub ts one_second

     

       128
        
               | `Ambiguous (ts, _) -> Timedesc.Span.sub ts one_second

     

       129
        
             in

     

       130
       -
             (match Timedesc.of_timestamp end_of_month_ts with

     

       131
        
             | Some end_of_month -> timedesc_to_ptime end_of_month

     

       132
        
             | None -> failwith "Invalid timestamp for end of month")

     

       133
        
         | Error _ -> failwith "Invalid date for end of month"

     

       134
        
       

     

       135
       -
       let get_end_of_current_month () = get_end_of_month (!get_today ())

     

       136
       -
       let get_end_of_next_month () = get_end_of_month (get_start_of_next_month ())

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       137
        
       

     

       138
       -
       let convert_relative_date_formats ~today ~tomorrow ~week ~month =

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       139
        
         if today then

     

       140
       -
           let today_date = !get_today () in

     

       141
        
           (* Set the end date to end-of-day to include all events on that day *)

     

       142
        
           let end_of_today = to_end_of_day today_date in

     

       143
        
           Some (today_date, end_of_today)

     

       144
        
         else if tomorrow then

     

       145
       -
           let today = !get_today () in

     

       146
        
           let tomorrow_date = add_days today 1 in

     

       147
        
           (* Set the end date to end-of-day to include all events on that day *)

     

       148
        
           let end_of_tomorrow = to_end_of_day tomorrow_date in

     

       149
        
           Some (tomorrow_date, end_of_tomorrow)

     

       150
        
         else if week then

     

       151
       -
           let week_start = get_start_of_current_week () in

     

       152
        
           let week_end_date = add_days week_start 6 in

     

       153
        
           (* Sunday is 6 days from Monday *)

     

       154
        
           (* Set the end date to end-of-day to include all events on Sunday *)

     

       155
        
           let end_of_week = to_end_of_day week_end_date in

     

       156
        
           Some (week_start, end_of_week)

     

       157
        
         else if month then

     

       158
       -
           let month_start = get_start_of_current_month () in

     

       159
        
           let month_end = get_end_of_month month_start in

     

       160
        
           Some (month_start, month_end)

     

       161
        
         else None

     

       162
        
       

     

       163
        
       let ( let* ) = Result.bind

     

       164
        
       

     

       165
       -
       (* Parse a date string that could be ISO format or a relative expression *)

     

       166
       -
       let parse_date expr parameter =

     

       167
       -
         let iso_date_regex = Re.Pcre.regexp "^(\\d{4})-(\\d{2})-(\\d{2})$" in

     

       168
       -
         let relative_regex = Re.Pcre.regexp "^([+-])(\\d+)([dwm])$" in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       169
        
         match expr with

     

       170
       -
         | "today" -> Ok (!get_today ())

     

       171
       -
         | "tomorrow" -> Ok (add_days (!get_today ()) 1)

     

       172
       -
         | "yesterday" -> Ok (add_days (!get_today ()) (-1))

     

       173
        
         | "this-week" -> (

     

       174
        
             match parameter with

     

       175
       -
             | `From -> Ok (get_start_of_current_week ())

     

       176
       -
             | `To -> Ok (get_end_of_current_week ()))

     

       177
        
         | "next-week" -> (

     

       178
        
             match parameter with

     

       179
       -
             | `From -> Ok (get_start_of_next_week ())

     

       180
       -
             | `To -> Ok (get_end_of_next_week ()))

     

       181
        
         | "this-month" -> (

     

       182
        
             match parameter with

     

       183
       -
             | `From -> Ok (get_start_of_current_month ())

     

       184
       -
             | `To -> Ok (get_end_of_current_month ()))

     

       185
        
         | "next-month" -> (

     

       186
        
             match parameter with

     

       187
       -
             | `From -> Ok (get_start_of_next_month ())

     

       188
       -
             | `To -> Ok (get_end_of_next_month ()))

     

       189
       -
         | _ ->

     

       190
       -
             (* Try to parse as ISO date *)

     

       191
       -
             if Re.Pcre.pmatch ~rex:iso_date_regex expr then

     

       192
       -
               let year =

     

       193
       -
                 int_of_string

     

       194
       -
                   (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 1)

     

       195
       -
               in

     

       196
       -
               let month =

     

       197
       -
                 int_of_string

     

       198
       -
                   (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 2)

     

       199
       -
               in

     

       200
       -
               let day =

     

       201
       -
                 int_of_string

     

       202
       -
                   (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 3)

     

       203
       -
               in

     

       204
       -
               match Timedesc.Date.Ymd.make ~year ~month ~day with

     

       205
       -
               | Ok date ->

     

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

     

       207
       -
                   let dt = Timedesc.of_date_and_time_exn date midnight in

     

       208
       -
                   Ok (timedesc_to_ptime dt)

     

       209
       -
               | Error _ -> Error (`Msg (Printf.sprintf "Invalid date: %s" expr))

     

       210
       -
               (* Try to parse as relative expression +Nd, -Nd, etc. *)

     

       211
       -
             else if Re.Pcre.pmatch ~rex:relative_regex expr then

     

       212
       -
               let sign =

     

       213
       -
                 Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 1

     

       214
       -
               in

     

       215
       -
               let num =

     

       216
       -
                 int_of_string

     

       217
       -
                   (Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 2)

     

       218
       -
               in

     

       219
       -
               let unit =

     

       220
       -
                 Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 3

     

       221
       -
               in

     

       222
       -
               let multiplier = if sign = "+" then 1 else -1 in

     

       223
       -
               let value = num * multiplier in

     

       224
       -
               let today = !get_today () in

     

       225
       -
               match unit with

     

       226
       -
               | "d" -> Ok (add_days today value)

     

       227
       -
               | "w" -> (

     

       228
       -
                   let date = add_weeks today value in

     

       229
       -
                   match parameter with

     

       230
       -
                   | `From -> Ok (get_start_of_week date)

     

       231
       -
                   | `To -> Ok (get_end_of_week date))

     

       232
       -
               | "m" -> (

     

       233
       -
                   let date = add_months today value in

     

       234
       -
                   match parameter with

     

       235
       -
                   | `From -> Ok (get_start_of_month date)

     

       236
       -
                   | `To -> Ok (get_end_of_month date))

     

       237
       -
               | _ -> Error (`Msg (Printf.sprintf "Invalid date unit: %s" unit))

     

       238
       -
             else Error (`Msg (Printf.sprintf "Invalid date format: %s" expr))

     

       239
        
       

     

       240
        
       let parse_time str =

     

       241
        
         try

     
···

       261
        
           Error

     

       262
        
             (`Msg (Printf.sprintf "Error parsing time: %s" (Printexc.to_string e)))

     

       263
        
       

     

       264
       -
       let parse_date_time ~date ~time parameter =

     

       265
       -
         let* date_ptime = parse_date date parameter in

     

       266
       -
         let* (h, min, s) = parse_time time in

     

       267
       -
         

     

       268
       -
         let dt = ptime_to_timedesc date_ptime in

     

       269
        
         let date_part = Timedesc.date dt in

     

       270
       -
         

     

       271
        
         (* Create time *)

     

       272
        
         match Timedesc.Time.make ~hour:h ~minute:min ~second:s () with

     

       273
       -
         | Ok time_part ->

     

       274
        
             (* Combine date and time *)

     

       275
       -
             (match Timedesc.of_date_and_time date_part time_part with

     

       276
        
             | Ok combined -> Ok (timedesc_to_ptime combined)

     

       277
        
             | Error _ -> Error (`Msg "Invalid date-time combination"))

     

       278
        
         | Error _ -> Error (`Msg "Invalid time for date-time combination")

     

       279
        
       

     

       280
       -
       let parse_date_time_opt ~date ?time parameter =

     

       281
       -
         match time with

     

       282
       -
         | None -> parse_date date parameter

     

       283
       -
         | Some time -> parse_date_time ~date ~time parameter

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
        
       open Result

     

       2
        
       

     

       3
       +
       let default_timezone =

     

       4
       +
         ref (fun () ->

     

       5
       +
             match Timedesc.Time_zone.local () with

     

       6
       +
             | Some tz -> tz

     

       7
       +
             | None -> Timedesc.Time_zone.utc)

     

       8
       +
       

     

       9
        
       let timedesc_to_ptime dt =

     

       10
       +
         match

     

       11
       +
           Timedesc.to_timestamp_single dt |> Timedesc.Utils.ptime_of_timestamp

     

       12
       +
         with

     

       13
        
         | Some t -> t

     

       14
        
         | None -> failwith "Invalid date conversion from Timedesc to Ptime"

     

       15
        
       

     

       16
       +
       let ptime_to_timedesc ?(tz = !default_timezone ()) ptime =

     

       17
        
         let ts = Timedesc.Utils.timestamp_of_ptime ptime in

     

       18
       +
         match Timedesc.of_timestamp ~tz_of_date_time:tz ts with

     

       19
        
         | Some dt -> dt

     

       20
        
         | None -> failwith "Invalid date conversion from Ptime to Timedesc"

     

       21
        
       

     

       22
        
       let get_today =

     

       23
       +
         ref (fun ?(tz = !default_timezone ()) () ->

     

       24
       +
             let now = Timedesc.now ~tz_of_date_time:tz () in

     

       25
        
             let date = Timedesc.date now in

     

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

     

       27
       +
             let dt = Timedesc.of_date_and_time_exn ~tz date midnight in

     

       28
        
             timedesc_to_ptime dt)

     

       29
        
       

     

       30
        
       (* Convert a midnight timestamp to end-of-day (23:59:59) *)

     

       31
        
       let to_end_of_day date =

     

       32
        
         let dt = ptime_to_timedesc date in

     

       33
        
         let date = Timedesc.date dt in

     

       34
       +
         let end_of_day_time =

     

       35
       +
           Timedesc.Time.make_exn ~hour:23 ~minute:59 ~second:59 ()

     

       36
       +
         in

     

       37
        
         let end_of_day = Timedesc.of_date_and_time_exn date end_of_day_time in

     

       38
        
         timedesc_to_ptime end_of_day

     

       39
        
       

     
···

       45
        
         let new_dt = Timedesc.of_date_and_time_exn new_date time in

     

       46
        
         timedesc_to_ptime new_dt

     

       47
        
       

     

       48
       +
       let add_weeks date weeks = add_days date (weeks * 7)

     

       0
        
       
     

       49
        
       

     

       50
        
       let add_months date months =

     

       51
        
         let dt = ptime_to_timedesc date in

     
···

       53
        
         let year = Timedesc.Ym.year old_ym in

     

       54
        
         let month = Timedesc.Ym.month old_ym in

     

       55
        
         let day = Timedesc.day dt in

     

       56
       +
       

     

       57
        
         (* Calculate new year and month *)

     

       58
        
         let total_month = (year * 12) + month - 1 + months in

     

       59
        
         let new_year = total_month / 12 in

     

       60
        
         let new_month = (total_month mod 12) + 1 in

     

       61
       +
       

     

       62
        
         (* Try to create new date, handling end of month cases properly *)

     

       63
        
         let rec adjust_day d =

     

       64
        
           match Timedesc.Date.Ymd.make ~year:new_year ~month:new_month ~day:d with

     

       65
       +
           | Ok new_date ->

     

       66
        
               let time = Timedesc.time dt in

     

       67
        
               let new_dt = Timedesc.of_date_and_time_exn new_date time in

     

       68
        
               timedesc_to_ptime new_dt

     

       69
       +
           | Error _ ->

     

       70
        
               if d > 1 then adjust_day (d - 1)

     

       71
        
               else failwith "Invalid date after adding months"

     

       72
        
         in

     

       73
        
         adjust_day day

     

       74
        
       

     

       75
       +
       let add_years date years = add_months date (years * 12)

     

       0
        
       
     

       76
        
       

     

       77
        
       let get_start_of_week date =

     

       78
        
         let dt = ptime_to_timedesc date in

     
···

       87
        
           | `Sat -> 5

     

       88
        
           | `Sun -> 6

     

       89
        
         in

     

       90
       +
         let monday_date =

     

       91
       +
           Timedesc.Date.sub ~days:days_to_subtract (Timedesc.date dt)

     

       92
       +
         in

     

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

     

       94
       +
         let monday_with_midnight =

     

       95
       +
           Timedesc.of_date_and_time_exn monday_date midnight

     

       96
       +
         in

     

       97
        
         timedesc_to_ptime monday_with_midnight

     

       98
        
       

     

       99
       +
       let get_start_of_current_week ?(tz = !default_timezone ()) () =

     

       100
       +
         get_start_of_week (!get_today ~tz ())

     

       101
       +
       

     

       102
       +
       let get_start_of_next_week ?(tz = !default_timezone ()) () =

     

       103
       +
         add_days (get_start_of_current_week ~tz ()) 7

     

       104
       +
       

     

       105
        
       let get_end_of_week date = add_days (get_start_of_week date) 6

     

       106
       +
       

     

       107
       +
       let get_end_of_current_week ?(tz = !default_timezone ()) () =

     

       108
       +
         get_end_of_week (!get_today ~tz ())

     

       109
       +
       

     

       110
       +
       let get_end_of_next_week ?(tz = !default_timezone ()) () =

     

       111
       +
         get_end_of_week (get_start_of_next_week ~tz ())

     

       112
        
       

     

       113
        
       let get_start_of_month date =

     

       114
        
         let dt = ptime_to_timedesc date in

     

       115
        
         let year = Timedesc.year dt in

     

       116
        
         let month = Timedesc.month dt in

     

       117
       +
       

     

       118
        
         (* Create a date for the first of the month *)

     

       119
        
         match Timedesc.Date.Ymd.make ~year ~month ~day:1 with

     

       120
        
         | Ok first_day ->

     
···

       123
        
             timedesc_to_ptime first_of_month

     

       124
        
         | Error _ -> failwith "Invalid date for start of month"

     

       125
        
       

     

       126
       +
       let get_start_of_current_month ?(tz = !default_timezone ()) () =

     

       127
       +
         get_start_of_month (!get_today ~tz ())

     

       128
       +
       

     

       129
       +
       let get_start_of_next_month ?(tz = !default_timezone ()) () =

     

       130
       +
         add_months (get_start_of_current_month ~tz ()) 1

     

       131
        
       

     

       132
        
       let get_end_of_month date =

     

       133
        
         let dt = ptime_to_timedesc date in

     

       134
        
         let year = Timedesc.year dt in

     

       135
        
         let month = Timedesc.month dt in

     

       136
       +
       

     

       137
        
         (* Determine next month and year *)

     

       138
        
         let next_month_int = if month == 12 then 1 else month + 1 in

     

       139
        
         let next_month_year = if month == 12 then year + 1 else year in

     

       140
       +
       

     

       141
        
         (* Create a date for the first of next month *)

     

       142
       +
         match

     

       143
       +
           Timedesc.Date.Ymd.make ~year:next_month_year ~month:next_month_int ~day:1

     

       144
       +
         with

     

       145
       +
         | Ok first_of_next_month -> (

     

       146
        
             (* Create the timestamp and subtract 1 second *)

     

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

     

       148
       +
             let first_of_next_month_dt =

     

       149
       +
               Timedesc.of_date_and_time_exn first_of_next_month midnight

     

       150
       +
             in

     

       151
        
             let one_second = Timedesc.Span.For_human.make_exn ~seconds:1 () in

     

       152
       +
             let end_of_month_ts =

     

       153
        
               match Timedesc.to_timestamp first_of_next_month_dt with

     

       154
        
               | `Single ts -> Timedesc.Span.sub ts one_second

     

       155
        
               | `Ambiguous (ts, _) -> Timedesc.Span.sub ts one_second

     

       156
        
             in

     

       157
       +
             match Timedesc.of_timestamp end_of_month_ts with

     

       158
        
             | Some end_of_month -> timedesc_to_ptime end_of_month

     

       159
        
             | None -> failwith "Invalid timestamp for end of month")

     

       160
        
         | Error _ -> failwith "Invalid date for end of month"

     

       161
        
       

     

       162
       +
       let get_end_of_current_month ?(tz = !default_timezone ()) () =

     

       163
       +
         get_end_of_month (!get_today ~tz ())

     

       164
       +
       

     

       165
       +
       let get_end_of_next_month ?(tz = !default_timezone ()) () =

     

       166
       +
         get_end_of_month (get_start_of_next_month ~tz ())

     

       167
       +
       

     

       168
       +
       let get_start_of_year date =

     

       169
       +
         let dt = ptime_to_timedesc date in

     

       170
       +
         let year = Timedesc.year dt in

     

       171
       +
       

     

       172
       +
         (* Create a date for the first of January *)

     

       173
       +
         match Timedesc.Date.Ymd.make ~year ~month:1 ~day:1 with

     

       174
       +
         | Ok first_day ->

     

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

     

       176
       +
             let first_of_year = Timedesc.of_date_and_time_exn first_day midnight in

     

       177
       +
             timedesc_to_ptime first_of_year

     

       178
       +
         | Error _ -> failwith "Invalid date for start of year"

     

       179
       +
       

     

       180
       +
       let get_start_of_current_year ?(tz = !default_timezone ()) () =

     

       181
       +
         get_start_of_year (!get_today ~tz ())

     

       182
       +
       

     

       183
       +
       let get_start_of_next_year ?(tz = !default_timezone ()) () =

     

       184
       +
         add_years (get_start_of_current_year ~tz ()) 1

     

       185
       +
       

     

       186
       +
       let get_end_of_year date =

     

       187
       +
         let dt = ptime_to_timedesc date in

     

       188
       +
         let year = Timedesc.year dt in

     

       189
        
       

     

       190
       +
         (* Create a date for the last day of the year (December 31) *)

     

       191
       +
         match Timedesc.Date.Ymd.make ~year ~month:12 ~day:31 with

     

       192
       +
         | Ok last_day ->

     

       193
       +
             let end_of_day =

     

       194
       +
               Timedesc.Time.make_exn ~hour:23 ~minute:59 ~second:59 ()

     

       195
       +
             in

     

       196
       +
             let end_of_year = Timedesc.of_date_and_time_exn last_day end_of_day in

     

       197
       +
             timedesc_to_ptime end_of_year

     

       198
       +
         | Error _ -> failwith "Invalid date for end of year"

     

       199
       +
       

     

       200
       +
       let get_end_of_current_year ?(tz = !default_timezone ()) () =

     

       201
       +
         get_end_of_year (!get_today ~tz ())

     

       202
       +
       

     

       203
       +
       let get_end_of_next_year ?(tz = !default_timezone ()) () =

     

       204
       +
         get_end_of_year (get_start_of_next_year ~tz ())

     

       205
       +
       

     

       206
       +
       let convert_relative_date_formats ?(tz = !default_timezone ()) ~today ~tomorrow

     

       207
       +
           ~week ~month () =

     

       208
        
         if today then

     

       209
       +
           let today_date = !get_today ~tz () in

     

       210
        
           (* Set the end date to end-of-day to include all events on that day *)

     

       211
        
           let end_of_today = to_end_of_day today_date in

     

       212
        
           Some (today_date, end_of_today)

     

       213
        
         else if tomorrow then

     

       214
       +
           let today = !get_today ~tz () in

     

       215
        
           let tomorrow_date = add_days today 1 in

     

       216
        
           (* Set the end date to end-of-day to include all events on that day *)

     

       217
        
           let end_of_tomorrow = to_end_of_day tomorrow_date in

     

       218
        
           Some (tomorrow_date, end_of_tomorrow)

     

       219
        
         else if week then

     

       220
       +
           let week_start = get_start_of_current_week ~tz () in

     

       221
        
           let week_end_date = add_days week_start 6 in

     

       222
        
           (* Sunday is 6 days from Monday *)

     

       223
        
           (* Set the end date to end-of-day to include all events on Sunday *)

     

       224
        
           let end_of_week = to_end_of_day week_end_date in

     

       225
        
           Some (week_start, end_of_week)

     

       226
        
         else if month then

     

       227
       +
           let month_start = get_start_of_current_month ~tz () in

     

       228
        
           let month_end = get_end_of_month month_start in

     

       229
        
           Some (month_start, month_end)

     

       230
        
         else None

     

       231
        
       

     

       232
        
       let ( let* ) = Result.bind

     

       233
        
       

     

       234
       +
       let parse_full_iso_datet ~tz expr =

     

       235
       +
         let regex = Re.Pcre.regexp "^(\\d{4})-(\\d{1,2})-(\\d{1,2})$" in

     

       236
       +
         if Re.Pcre.pmatch ~rex:regex expr then

     

       237
       +
           let match_result = Re.Pcre.exec ~rex:regex expr in

     

       238
       +
           let year = int_of_string (Re.Pcre.get_substring match_result 1) in

     

       239
       +
           let month = int_of_string (Re.Pcre.get_substring match_result 2) in

     

       240
       +
           let day = int_of_string (Re.Pcre.get_substring match_result 3) in

     

       241
       +
           match Timedesc.Date.Ymd.make ~year ~month ~day with

     

       242
       +
           | Ok date ->

     

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

     

       244
       +
               let dt = Timedesc.of_date_and_time_exn ~tz date midnight in

     

       245
       +
               Some (Ok (timedesc_to_ptime dt))

     

       246
       +
           | Error _ -> Some (Error (`Msg (Printf.sprintf "Invalid date: %s" expr)))

     

       247
       +
         else None

     

       248
       +
       

     

       249
       +
       let parse_year_only ~tz expr parameter =

     

       250
       +
         let regex = Re.Pcre.regexp "^(\\d{4})$" in

     

       251
       +
         if Re.Pcre.pmatch ~rex:regex expr then

     

       252
       +
           let match_result = Re.Pcre.exec ~rex:regex expr in

     

       253
       +
           let year = int_of_string (Re.Pcre.get_substring match_result 1) in

     

       254
       +
           match parameter with

     

       255
       +
           | `From -> (

     

       256
       +
               match Timedesc.Date.Ymd.make ~year ~month:1 ~day:1 with

     

       257
       +
               | Ok date ->

     

       258
       +
                   let time = Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 () in

     

       259
       +
                   let dt = Timedesc.of_date_and_time_exn ~tz date time in

     

       260
       +
                   Some (Ok (timedesc_to_ptime dt))

     

       261
       +
               | Error _ ->

     

       262
       +
                   Some (Error (`Msg (Printf.sprintf "Invalid year: %s" expr))))

     

       263
       +
           | `To -> (

     

       264
       +
               match Timedesc.Date.Ymd.make ~year ~month:12 ~day:31 with

     

       265
       +
               | Ok date ->

     

       266
       +
                   let time =

     

       267
       +
                     Timedesc.Time.make_exn ~hour:23 ~minute:59 ~second:59 ()

     

       268
       +
                   in

     

       269
       +
                   let dt = Timedesc.of_date_and_time_exn ~tz date time in

     

       270
       +
                   Some (Ok (timedesc_to_ptime dt))

     

       271
       +
               | Error _ ->

     

       272
       +
                   Some (Error (`Msg (Printf.sprintf "Invalid year: %s" expr))))

     

       273
       +
         else None

     

       274
       +
       

     

       275
       +
       let parse_year_month ~tz expr parameter =

     

       276
       +
         let regex = Re.Pcre.regexp "^(\\d{4})-(\\d{1,2})$" in

     

       277
       +
         if Re.Pcre.pmatch ~rex:regex expr then

     

       278
       +
           let match_result = Re.Pcre.exec ~rex:regex expr in

     

       279
       +
           let year = int_of_string (Re.Pcre.get_substring match_result 1) in

     

       280
       +
           let month = int_of_string (Re.Pcre.get_substring match_result 2) in

     

       281
       +
           match parameter with

     

       282
       +
           | `From -> (

     

       283
       +
               match Timedesc.Date.Ymd.make ~year ~month ~day:1 with

     

       284
       +
               | Ok date ->

     

       285
       +
                   let time = Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 () in

     

       286
       +
                   let dt = Timedesc.of_date_and_time_exn ~tz date time in

     

       287
       +
                   Some (Ok (timedesc_to_ptime dt))

     

       288
       +
               | Error _ ->

     

       289
       +
                   Some (Error (`Msg (Printf.sprintf "Invalid year-month: %s" expr))))

     

       290
       +
           | `To -> (

     

       291
       +
               let next_month = if month = 12 then 1 else month + 1 in

     

       292
       +
               let next_month_year = if month = 12 then year + 1 else year in

     

       293
       +
               match

     

       294
       +
                 Timedesc.Date.Ymd.make ~year:next_month_year ~month:next_month ~day:1

     

       295
       +
               with

     

       296
       +
               | Ok next_month_date ->

     

       297
       +
                   let last_day_of_month = Timedesc.Date.sub ~days:1 next_month_date in

     

       298
       +
                   let end_of_day =

     

       299
       +
                     Timedesc.Time.make_exn ~hour:23 ~minute:59 ~second:59 ()

     

       300
       +
                   in

     

       301
       +
                   let dt =

     

       302
       +
                     Timedesc.of_date_and_time_exn ~tz last_day_of_month end_of_day

     

       303
       +
                   in

     

       304
       +
                   Some (Ok (timedesc_to_ptime dt))

     

       305
       +
               | Error _ ->

     

       306
       +
                   Some (Error (`Msg (Printf.sprintf "Invalid year-month: %s" expr))))

     

       307
       +
         else None

     

       308
       +
       

     

       309
       +
       let parse_relative ~tz expr parameter =

     

       310
       +
         let regex = Re.Pcre.regexp "^([+-])(\\d+)([dwmy])$" in

     

       311
       +
         if Re.Pcre.pmatch ~rex:regex expr then

     

       312
       +
           let match_result = Re.Pcre.exec ~rex:regex expr in

     

       313
       +
           let sign = Re.Pcre.get_substring match_result 1 in

     

       314
       +
           let num = int_of_string (Re.Pcre.get_substring match_result 2) in

     

       315
       +
           let unit = Re.Pcre.get_substring match_result 3 in

     

       316
       +
           let multiplier = if sign = "+" then 1 else -1 in

     

       317
       +
           let value = num * multiplier in

     

       318
       +
           let today = !get_today ~tz () in

     

       319
       +
           match unit with

     

       320
       +
           | "d" -> Some (Ok (add_days today value))

     

       321
       +
           | "w" -> (

     

       322
       +
               let date = add_weeks today value in

     

       323
       +
               match parameter with

     

       324
       +
               | `From -> Some (Ok (get_start_of_week date))

     

       325
       +
               | `To -> Some (Ok (get_end_of_week date)))

     

       326
       +
           | "m" -> (

     

       327
       +
               let date = add_months today value in

     

       328
       +
               match parameter with

     

       329
       +
               | `From -> Some (Ok (get_start_of_month date))

     

       330
       +
               | `To -> Some (Ok (get_end_of_month date)))

     

       331
       +
           | "y" -> (

     

       332
       +
               let date = add_years today value in

     

       333
       +
               match parameter with

     

       334
       +
               | `From -> Some (Ok (get_start_of_year date))

     

       335
       +
               | `To -> Some (Ok (get_end_of_year date)))

     

       336
       +
           | _ -> Some (Error (`Msg (Printf.sprintf "Invalid date unit: %s" unit)))

     

       337
       +
         else None

     

       338
       +
       

     

       339
       +
       let parse_date ?(tz = !default_timezone ()) expr parameter =

     

       340
        
         match expr with

     

       341
       +
         | "today" -> Ok (!get_today ~tz ())

     

       342
       +
         | "tomorrow" -> Ok (add_days (!get_today ~tz ()) 1)

     

       343
       +
         | "yesterday" -> Ok (add_days (!get_today ~tz ()) (-1))

     

       344
        
         | "this-week" -> (

     

       345
        
             match parameter with

     

       346
       +
             | `From -> Ok (get_start_of_current_week ~tz ())

     

       347
       +
             | `To -> Ok (get_end_of_current_week ~tz ()))

     

       348
        
         | "next-week" -> (

     

       349
        
             match parameter with

     

       350
       +
             | `From -> Ok (get_start_of_next_week ~tz ())

     

       351
       +
             | `To -> Ok (get_end_of_next_week ~tz ()))

     

       352
        
         | "this-month" -> (

     

       353
        
             match parameter with

     

       354
       +
             | `From -> Ok (get_start_of_current_month ~tz ())

     

       355
       +
             | `To -> Ok (get_end_of_current_month ~tz ()))

     

       356
        
         | "next-month" -> (

     

       357
        
             match parameter with

     

       358
       +
             | `From -> Ok (get_start_of_next_month ~tz ())

     

       359
       +
             | `To -> Ok (get_end_of_next_month ~tz ()))

     

       360
       +
         | _ -> (

     

       361
       +
             (* Option alternative operator *)

     

       362
       +
             let ( |>? ) opt f = match opt with None -> f () | Some x -> Some x in

     

       363
       +
             ( ( ( parse_full_iso_datet ~tz expr |>? fun () ->

     

       364
       +
                   parse_year_only ~tz expr parameter )

     

       365
       +
               |>? fun () -> parse_year_month ~tz expr parameter )

     

       366
       +
             |>? fun () -> parse_relative ~tz expr parameter )

     

       367
       +
             |> function

     

       368
       +
             | Some result -> result

     

       369
       +
             | None -> Error (`Msg (Printf.sprintf "Invalid date format: %s" expr)))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       370
        
       

     

       371
        
       let parse_time str =

     

       372
        
         try

     
···

       392
        
           Error

     

       393
        
             (`Msg (Printf.sprintf "Error parsing time: %s" (Printexc.to_string e)))

     

       394
        
       

     

       395
       +
       let parse_date_time ?(tz = !default_timezone ()) ~date ~time parameter =

     

       396
       +
         let* date_ptime = parse_date date parameter ~tz in

     

       397
       +
         let* h, min, s = parse_time time in

     

       398
       +
       

     

       399
       +
         let dt = ptime_to_timedesc ~tz date_ptime in

     

       400
        
         let date_part = Timedesc.date dt in

     

       401
       +
       

     

       402
        
         (* Create time *)

     

       403
        
         match Timedesc.Time.make ~hour:h ~minute:min ~second:s () with

     

       404
       +
         | Ok time_part -> (

     

       405
        
             (* Combine date and time *)

     

       406
       +
             match Timedesc.of_date_and_time ~tz date_part time_part with

     

       407
        
             | Ok combined -> Ok (timedesc_to_ptime combined)

     

       408
        
             | Error _ -> Error (`Msg "Invalid date-time combination"))

     

       409
        
         | Error _ -> Error (`Msg "Invalid time for date-time combination")

     

       410
        
       

     

       411
       +
       let ptime_of_ical = function

     

       412
       +
         | `Datetime (`Utc t) -> t

     

       413
       +
         | `Datetime (`Local t) ->

     

       414
       +
             let tz = Timedesc.Time_zone.local_exn () in

     

       415
       +
             let ts = Timedesc.Utils.timestamp_of_ptime t in

     

       416
       +
             (* Icalendar gives us the Ptime in UTC, which we parse to a Timedesc *)

     

       417
       +
             let dt =

     

       418
       +
               Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc ts

     

       419
       +
             in

     

       420
       +
             (* We extract the datetime, and reinterpret it in the appropriate timezone *)

     

       421
       +
             let date = Timedesc.date dt in

     

       422
       +
             let time = Timedesc.time dt in

     

       423
       +
             let dt = Timedesc.of_date_and_time_exn ~tz date time in

     

       424
       +
             timedesc_to_ptime dt

     

       425
       +
         | `Datetime (`With_tzid (t, (_, tzid))) ->

     

       426
       +
             let tz =

     

       427
       +
               match Timedesc.Time_zone.make tzid with

     

       428
       +
               | Some tz -> tz

     

       429
       +
               | None -> failwith (Printf.sprintf "Warning: Unknown timezone %s" tzid)

     

       430
       +
             in

     

       431
       +
             (* Icalendar gives us the Ptime in UTC, which we parse to a Timedesc *)

     

       432
       +
             let ts = Timedesc.Utils.timestamp_of_ptime t in

     

       433
       +
             let dt =

     

       434
       +
               Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc ts

     

       435
       +
             in

     

       436
       +
             (* We extract the datetime, and reinterpret it in the appropriate timezone *)

     

       437
       +
             let date = Timedesc.date dt in

     

       438
       +
             let time = Timedesc.time dt in

     

       439
       +
             let dt = Timedesc.of_date_and_time_exn ~tz date time in

     

       440
       +
             timedesc_to_ptime dt

     

       441
       +
         | `Date date -> (

     

       442
       +
             let y, m, d = date in

     

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

     

       444
       +
             | Ok new_date ->

     

       445
       +
                 let midnight =

     

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

     

       447
       +
                 in

     

       448
       +
                 let new_dt = Timedesc.of_date_and_time_exn new_date midnight in

     

       449
       +
                 timedesc_to_ptime new_dt

     

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

+103 -39

lib/date.mli

···

       1
       -
       val get_today : (unit -> Ptime.t) ref

     

       2
       -
       (** Get the current date at midnight. This is a reference to support testing.

     

       3
       -
           Returns the date or raises an exception if the date cannot be determined. *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       4
        
       

     

       5
        
       val to_end_of_day : Ptime.t -> Ptime.t

     

       6
        
       (** Converts a date with midnight time (00:00:00) to the same date with

     
···

       28
        
       (** Get the start of the week (Monday) for the given date. Raises an exception

     

       29
        
           if the date cannot be calculated. *)

     

       30
        
       

     

       31
       -
       val get_start_of_current_week : unit -> Ptime.t

     

       32
       -
       (** Get the start of the current week. Raises an exception if the date cannot be

     

       33
       -
           calculated. *)

     

       0
        
       
     

       34
        
       

     

       35
       -
       val get_start_of_next_week : unit -> Ptime.t

     

       36
       -
       (** Get the start of next week. Raises an exception if the date cannot be

     

       37
       -
           calculated. *)

     

       0
        
       
     

       38
        
       

     

       39
        
       val get_end_of_week : Ptime.t -> Ptime.t

     

       40
        
       (** Get the end of the week (Monday) for the given date. Raises an exception if

     

       41
        
           the date cannot be calculated. *)

     

       42
        
       

     

       43
       -
       val get_end_of_current_week : unit -> Ptime.t

     

       44
       -
       (** Get the end of the current week. Raises an exception if the date cannot be

     

       45
       -
           calculated. *)

     

       0
        
       
     

       46
        
       

     

       47
       -
       val get_end_of_next_week : unit -> Ptime.t

     

       48
       -
       (** Get the end of next week. Raises an exception if the date cannot be

     

       49
       -
           calculated. *)

     

       0
        
       
     

       50
        
       

     

       51
        
       val get_start_of_month : Ptime.t -> Ptime.t

     

       52
        
       (** Get the start of the month for the given date. Raises an exception if the

     

       53
        
           date cannot be calculated. *)

     

       54
        
       

     

       55
       -
       val get_start_of_current_month : unit -> Ptime.t

     

       56
       -
       (** Get the start of the current month. Raises an exception if the date cannot

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       57
        
           be calculated. *)

     

       58
        
       

     

       59
       -
       val get_start_of_next_month : unit -> Ptime.t

     

       60
       -
       (** Get the start of next month. Raises an exception if the date cannot be

     

       61
       -
           calculated. *)

     

       0
        
       
     

       62
        
       

     

       63
       -
       val get_end_of_current_month : unit -> Ptime.t

     

       64
       -
       (** Get the end of the current month. Raises an exception if the date cannot be

     

       65
       -
           calculated. *)

     

       66
       -
       

     

       67
       -
       val get_end_of_next_month : unit -> Ptime.t

     

       68
       -
       (** Get the end of next month. Raises an exception if the date cannot be

     

       69
       -
           calculated. *)

     

       70
        
       

     

       71
        
       val get_end_of_month : Ptime.t -> Ptime.t

     

       72
        
       (** Get the end of the month for the given date. Raises an exception if the date

     

       73
        
           cannot be calculated. *)

     

       74
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       75
        
       val convert_relative_date_formats :

     

       0
        
       
     

       76
        
         today:bool ->

     

       77
        
         tomorrow:bool ->

     

       78
        
         week:bool ->

     

       79
        
         month:bool ->

     

       0
        
       
     

       80
        
         (Ptime.t * Ptime.t) option

     

       81
       -
       (** Converts relative date formats to determine from/to dates. Returns a tuple

     

       82
       -
           of (start_date, end_date) or raises an exception if the dates could not be

     

       83
       -
           determined. **)

     

       0
        
       
     

       84
        
       

     

       85
        
       val parse_date :

     

       86
       -
         string -> [ `To | `From ] -> (Ptime.t, [> `Msg of string ]) result

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       87
        
       (** Parse a date string that could be ISO format (YYYY-MM-DD) or a relative

     

       88
       -
           expression.

     

       0
        
       
     

       89
        
       

     

       90
        
           Supported formats:

     

       91
       -
           - ISO format: "YYYY-MM-DD"

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       92
        
           - Relative expressions:

     

       93
        
           - "today" - Current day

     

       94
        
           - "tomorrow" - Next day

     
···

       100
        
           - "+Nd" - N days from today (e.g., "+7d" for a week from today)

     

       101
        
           - "-Nd" - N days before today (e.g., "-7d" for a week ago)

     

       102
        
           - "+Nw" - N weeks from today

     

       103
       -
           - "+Nm" - N months from today *)

     

       0
        
       
     

       104
        
       

     

       105
        
       val parse_time : string -> (int * int * int, [> `Msg of string ]) result

     

       106
        
       (** Parse a time string in HH:MM or HH:MM:SS format. Returns Ok with (hour,

     

       107
        
           minute, second) or Error with a message. **)

     

       108
        
       

     

       109
        
       val parse_date_time :

     

       0
        
       
     

       110
        
         date:string ->

     

       111
        
         time:string ->

     

       112
        
         [ `To | `From ] ->

     

       113
        
         (Ptime.t, [> `Msg of string ]) result

     

       0
        
       
     

       0
        
       
     

       114
        
       

     

       115
       -
       val parse_date_time_opt :

     

       116
       -
         date:string ->

     

       117
       -
         ?time:string ->

     

       118
       -
         [ `To | `From ] ->

     

       119
       -
         (Ptime.t, [> `Msg of string ]) result

···

       1
       +
       val default_timezone : (unit -> Timedesc.Time_zone.t) ref

     

       2
       +
       (** Default timezone to use for date operations. Defaults to the local timezone

     

       3
       +
           of the system, falling back to UTC if local timezone cannot be determined.

     

       4
       +
       *)

     

       5
       +
       

     

       6
       +
       val timedesc_to_ptime : Timedesc.t -> Ptime.t

     

       7
       +
       (** Convert a Timedesc.t to a Ptime.t. *)

     

       8
       +
       

     

       9
       +
       val ptime_to_timedesc : ?tz:Timedesc.Time_zone.t -> Ptime.t -> Timedesc.t

     

       10
       +
       (** Convert a Ptime.t to a Timedesc.t with the specified timezone. If no

     

       11
       +
           timezone is provided, uses the default_timezone. *)

     

       12
       +
       

     

       13
       +
       val get_today : (?tz:Timedesc.Time_zone.t -> unit -> Ptime.t) ref

     

       14
       +
       (** Get the current date at midnight in the specified timezone. If no timezone

     

       15
       +
           is provided, uses the default_timezone. This is a reference to support

     

       16
       +
           testing. Returns the date or raises an exception if the date cannot be

     

       17
       +
           determined. *)

     

       18
        
       

     

       19
        
       val to_end_of_day : Ptime.t -> Ptime.t

     

       20
        
       (** Converts a date with midnight time (00:00:00) to the same date with

     
···

       42
        
       (** Get the start of the week (Monday) for the given date. Raises an exception

     

       43
        
           if the date cannot be calculated. *)

     

       44
        
       

     

       45
       +
       val get_start_of_current_week : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       46
       +
       (** Get the start of the current week in the specified timezone. If no timezone

     

       47
       +
           is provided, uses the default_timezone. Raises an exception if the date

     

       48
       +
           cannot be calculated. *)

     

       49
        
       

     

       50
       +
       val get_start_of_next_week : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       51
       +
       (** Get the start of next week in the specified timezone. If no timezone is

     

       52
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       53
       +
           be calculated. *)

     

       54
        
       

     

       55
        
       val get_end_of_week : Ptime.t -> Ptime.t

     

       56
        
       (** Get the end of the week (Monday) for the given date. Raises an exception if

     

       57
        
           the date cannot be calculated. *)

     

       58
        
       

     

       59
       +
       val get_end_of_current_week : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       60
       +
       (** Get the end of the current week in the specified timezone. If no timezone is

     

       61
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       62
       +
           be calculated. *)

     

       63
        
       

     

       64
       +
       val get_end_of_next_week : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       65
       +
       (** Get the end of next week in the specified timezone. If no timezone is

     

       66
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       67
       +
           be calculated. *)

     

       68
        
       

     

       69
        
       val get_start_of_month : Ptime.t -> Ptime.t

     

       70
        
       (** Get the start of the month for the given date. Raises an exception if the

     

       71
        
           date cannot be calculated. *)

     

       72
        
       

     

       73
       +
       val get_start_of_current_month : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       74
       +
       (** Get the start of the current month in the specified timezone. If no timezone

     

       75
       +
           is provided, uses the default_timezone. Raises an exception if the date

     

       76
       +
           cannot be calculated. *)

     

       77
       +
       

     

       78
       +
       val get_start_of_next_month : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       79
       +
       (** Get the start of next month in the specified timezone. If no timezone is

     

       80
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       81
        
           be calculated. *)

     

       82
        
       

     

       83
       +
       val get_end_of_current_month : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       84
       +
       (** Get the end of the current month in the specified timezone. If no timezone

     

       85
       +
           is provided, uses the default_timezone. Raises an exception if the date

     

       86
       +
           cannot be calculated. *)

     

       87
        
       

     

       88
       +
       val get_end_of_next_month : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       89
       +
       (** Get the end of next month in the specified timezone. If no timezone is

     

       90
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       91
       +
           be calculated. *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       92
        
       

     

       93
        
       val get_end_of_month : Ptime.t -> Ptime.t

     

       94
        
       (** Get the end of the month for the given date. Raises an exception if the date

     

       95
        
           cannot be calculated. *)

     

       96
        
       

     

       97
       +
       val get_start_of_year : Ptime.t -> Ptime.t

     

       98
       +
       (** Get the start of the year (Jan 1) for the given date. Raises an exception if

     

       99
       +
           the date cannot be calculated. *)

     

       100
       +
       

     

       101
       +
       val get_start_of_current_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       102
       +
       (** Get the start of the current year in the specified timezone. If no timezone

     

       103
       +
           is provided, uses the default_timezone. Raises an exception if the date

     

       104
       +
           cannot be calculated. *)

     

       105
       +
       

     

       106
       +
       val get_start_of_next_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       107
       +
       (** Get the start of next year in the specified timezone. If no timezone is

     

       108
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       109
       +
           be calculated. *)

     

       110
       +
       

     

       111
       +
       val get_end_of_year : Ptime.t -> Ptime.t

     

       112
       +
       (** Get the end of the year (Dec 31, 23:59:59) for the given date. Raises an

     

       113
       +
           exception if the date cannot be calculated. *)

     

       114
       +
       

     

       115
       +
       val get_end_of_current_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       116
       +
       (** Get the end of the current year in the specified timezone. If no timezone is

     

       117
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       118
       +
           be calculated. *)

     

       119
       +
       

     

       120
       +
       val get_end_of_next_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       121
       +
       (** Get the end of next year in the specified timezone. If no timezone is

     

       122
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       123
       +
           be calculated. *)

     

       124
       +
       

     

       125
        
       val convert_relative_date_formats :

     

       126
       +
         ?tz:Timedesc.Time_zone.t ->

     

       127
        
         today:bool ->

     

       128
        
         tomorrow:bool ->

     

       129
        
         week:bool ->

     

       130
        
         month:bool ->

     

       131
       +
         unit ->

     

       132
        
         (Ptime.t * Ptime.t) option

     

       133
       +
       (** Converts relative date formats to determine from/to dates in the specified

     

       134
       +
           timezone. If no timezone is provided, uses the default_timezone. Returns a

     

       135
       +
           tuple of (start_date, end_date) or raises an exception if the dates could

     

       136
       +
           not be determined. **)

     

       137
        
       

     

       138
        
       val parse_date :

     

       139
       +
         ?tz:Timedesc.Time_zone.t ->

     

       140
       +
         string ->

     

       141
       +
         [ `To | `From ] ->

     

       142
       +
         (Ptime.t, [> `Msg of string ]) result

     

       143
        
       (** Parse a date string that could be ISO format (YYYY-MM-DD) or a relative

     

       144
       +
           expression in the specified timezone. If no timezone is provided, uses the

     

       145
       +
           default_timezone.

     

       146
        
       

     

       147
        
           Supported formats:

     

       148
       +
           - ISO format:

     

       149
       +
           - "YYYY-MM-DD" (full date)

     

       150
       +
           - "YYYY-MM" (partial date)

     

       151
       +
           - For --from: defaults to first day of month

     

       152
       +
           - For --to: defaults to last day of month

     

       153
       +
           - "YYYY" (partial date)

     

       154
       +
           - For --from: defaults to January 1st of year

     

       155
       +
           - For --to: defaults to December 31st of year

     

       156
        
           - Relative expressions:

     

       157
        
           - "today" - Current day

     

       158
        
           - "tomorrow" - Next day

     
···

       164
        
           - "+Nd" - N days from today (e.g., "+7d" for a week from today)

     

       165
        
           - "-Nd" - N days before today (e.g., "-7d" for a week ago)

     

       166
        
           - "+Nw" - N weeks from today

     

       167
       +
           - "+Nm" - N months from today

     

       168
       +
           - "+Ny" - N years from today *)

     

       169
        
       

     

       170
        
       val parse_time : string -> (int * int * int, [> `Msg of string ]) result

     

       171
        
       (** Parse a time string in HH:MM or HH:MM:SS format. Returns Ok with (hour,

     

       172
        
           minute, second) or Error with a message. **)

     

       173
        
       

     

       174
        
       val parse_date_time :

     

       175
       +
         ?tz:Timedesc.Time_zone.t ->

     

       176
        
         date:string ->

     

       177
        
         time:string ->

     

       178
        
         [ `To | `From ] ->

     

       179
        
         (Ptime.t, [> `Msg of string ]) result

     

       180
       +
       (** Parse a date and time string in the specified timezone. If no timezone is

     

       181
       +
           provided, uses the default_timezone. *)

     

       182
        
       

     

       183
       +
       val ptime_of_ical : Icalendar.date_or_datetime -> Ptime.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+4 -2

lib/dune

···

       13
        
         yojson

     

       14
        
         uuidm

     

       15
        
         eio

     

       16
       -
         eio_main)

     

       0
        
       
     

       0
        
       
     

       17
        
        (preprocess

     

       18
       -
         (pps ppx_deriving.show ppx_deriving.eq)))

···

       13
        
         yojson

     

       14
        
         uuidm

     

       15
        
         eio

     

       16
       +
         eio_main

     

       17
       +
         cmdliner

     

       18
       +
         sexplib)

     

       19
        
        (preprocess

     

       20
       +
         (pps ppx_deriving.show ppx_deriving.eq ppx_sexp_conv)))

+713 -75

lib/event.ml

···

       1
        
       open Icalendar

     

       2
        
       

     

       3
        
       type event_id = string

     

       4
       -
       type t = { collection : Collection.t; file_name : string; ical : event }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       5
        
       type date_error = [ `Msg of string ]

     

       6
        
       

     

       7
       -
       (* TODO handle timezones *)

     

       8
       -
       let ptime_of_datetime = function

     

       9
       -
         | `Datetime (`Utc t) -> t

     

       10
       -
         | `Datetime (`Local t) -> t

     

       11
       -
         | `Datetime (`With_tzid (t, _)) -> t

     

       12
       -
         | `Date date -> (

     

       13
       -
             match Ptime.of_date date with

     

       14
       -
             | Some t -> t

     

       15
       -
             | None ->

     

       16
       -
                 let year, month, day = date in

     

       17
       -
                 failwith (Printf.sprintf "Invalid date %d-%d-%d" year month day))

     

       18
       -
       

     

       19
        
       let generate_uuid () =

     

       20
        
         let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) () in

     

       21
        
         Uuidm.to_string uuid

     

       22
        
       

     

       23
       -
       let create ~summary ~start ?end_ ?location ?description ?recurrence collection =

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       24
        
         let uuid = generate_uuid () in

     

       25
        
         let uid = (Params.empty, uuid) in

     

       26
        
         let file_name = uuid ^ ".ics" in

     

       27
       -
         let dtstart = (Params.empty, `Datetime (`Utc start)) in

     

       28
       -
         let dtend_or_duration =

     

       29
       -
           Option.map (fun d -> `Dtend (Params.empty, `Datetime (`Utc d))) end_

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       30
        
         in

     

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

     

       32
        
         let now = Ptime_clock.now () in

     
···

       41
        
           | Some desc -> `Description (Params.empty, desc) :: props

     

       42
        
           | None -> props

     

       43
        
         in

     

       44
       -
         let ical =

     

       45
        
           {

     

       46
        
             dtstamp = (Params.empty, now);

     

       47
        
             uid;

     
···

       52
        
             alarms = [];

     

       53
        
           }

     

       54
        
         in

     

       55
       -
         { collection; file_name; ical }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       56
        
       

     

       57
        
       let edit ?summary ?start ?end_ ?location ?description ?recurrence t =

     

       58
        
         let now = Ptime_clock.now () in

     

       59
       -
         let uid = t.ical.uid in

     

       60
       -
         let dtstart =

     

       61
       -
           match start with

     

       62
       -
           | None -> t.ical.dtstart

     

       63
       -
           | Some s -> (Params.empty, `Datetime (`Utc s))

     

       64
        
         in

     

       65
       -
         let dtend_or_duration =

     

       66
       -
           match end_ with

     

       67
       -
           | None -> t.ical.dtend_or_duration

     

       68
       -
           | Some d -> Some (`Dtend (Params.empty, `Datetime (`Utc d)))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       69
        
         in

     

       70
        
         let rrule =

     

       71
        
           match recurrence with

     

       72
       -
           | None -> t.ical.rrule

     

       73
        
           | Some r -> Some (Params.empty, r)

     

       74
        
         in

     

       75
        
         let props =

     
···

       80
        
               | `Description _ -> (

     

       81
        
                   match description with None -> true | Some _ -> false)

     

       82
        
               | _ -> true)

     

       83
       -
             t.ical.props

     

       84
        
         in

     

       85
        
         let props =

     

       86
        
           match summary with

     
···

       97
        
           | Some desc -> `Description (Params.empty, desc) :: props

     

       98
        
           | None -> props

     

       99
        
         in

     

       100
       -
         let alarms = t.ical.alarms in

     

       101
       -
         let ical =

     

       102
        
           {

     

       103
        
             dtstamp = (Params.empty, now);

     

       104
        
             uid;

     
···

       109
        
             alarms;

     

       110
        
           }

     

       111
        
         in

     

       112
       -
         let collection = t.collection in

     

       113
       -
         let file_name = t.file_name in

     

       114
       -
         { collection; file_name; ical }

     

       0
        
       
     

       115
        
       

     

       116
       -
       let of_icalendar collection ~file_name (ical : event) =

     

       117
       -
         { collection; file_name; ical }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       118
        
       

     

       119
       -
       let to_icalendar t =

     

       120
       -
         let now = Ptime_clock.now () in

     

       121
       -
         let uid = t.ical.uid in

     

       122
       -
         let dtstart = t.ical.dtstart in

     

       123
       -
         let dtend_or_duration = t.ical.dtend_or_duration in

     

       124
       -
         let rrule = t.ical.rrule in

     

       125
       -
         let props = t.ical.props in

     

       126
       -
         let alarms = t.ical.alarms in

     

       127
       -
         {

     

       128
       -
           dtstamp = (Params.empty, now);

     

       129
       -
           uid;

     

       130
       -
           dtstart;

     

       131
       -
           dtend_or_duration;

     

       132
       -
           rrule;

     

       133
       -
           props;

     

       134
       -
           alarms;

     

       135
       -
         }

     

       136
       -
       

     

       137
       -
       let get_id t = snd t.ical.uid

     

       138
        
       

     

       139
        
       let get_summary t =

     

       140
        
         match

     

       141
        
           List.filter_map

     

       142
        
             (function `Summary (_, s) when s <> "" -> Some s | _ -> None)

     

       143
       -
             t.ical.props

     

       144
        
         with

     

       145
        
         | s :: _ -> Some s

     

       146
        
         | _ -> None

     

       147
        
       

     

       148
       -
       let get_start t = ptime_of_datetime (snd t.ical.dtstart)

     

       0
        
       
     

       149
        
       

     

       150
       -
       let get_end t =

     

       151
       -
         match t.ical.dtend_or_duration with

     

       152
       -
         | Some (`Dtend (_, d)) -> Some (ptime_of_datetime d)

     

       153
        
         | Some (`Duration (_, span)) -> (

     

       154
       -
             let start = get_start t in

     

       155
        
             match Ptime.add_span start span with

     

       156
        
             | Some t -> Some t

     

       157
        
             | None ->

     
···

       161
        
                      (Printf.sprintf "%.2fs" (Ptime.Span.to_float_s span))))

     

       162
        
         | None -> None

     

       163
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       164
        
       let get_duration t =

     

       165
       -
         match t.ical.dtend_or_duration with

     

       166
        
         | Some (`Duration (_, span)) -> Some span

     

       167
        
         | Some (`Dtend (_, e)) ->

     

       168
       -
             let span = Ptime.diff (ptime_of_datetime e) (get_start t) in

     

       169
        
             Some span

     

       170
        
         | None -> None

     

       171
        
       

     

       172
       -
       let get_day_event t =

     

       173
       -
         match (t.ical.dtstart, t.ical.dtend_or_duration) with

     

       174
        
         | (_, `Date _), _ -> true

     

       175
        
         | _, Some (`Dtend (_, `Date _)) -> true

     

       176
        
         | _ -> false

     
···

       179
        
         match

     

       180
        
           List.filter_map

     

       181
        
             (function `Location (_, s) when s <> "" -> Some s | _ -> None)

     

       182
       -
             t.ical.props

     

       183
        
         with

     

       184
        
         | s :: _ -> Some s

     

       185
        
         | _ -> None

     
···

       188
        
         match

     

       189
        
           List.filter_map

     

       190
        
             (function `Description (_, s) when s <> "" -> Some s | _ -> None)

     

       191
       -
             t.ical.props

     

       192
        
         with

     

       193
        
         | s :: _ -> Some s

     

       194
        
         | _ -> None

     

       195
        
       

     

       196
       -
       let get_recurrence t = Option.map (fun r -> snd r) t.ical.rrule

     

       197
       -
       let get_collection t = t.collection

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       198
        
       

     

       199
       -
       let get_file_path ~fs ~calendar_dir_path t =

     

       200
       -
         Eio.Path.(

     

       201
       -
           fs / calendar_dir_path

     

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

     

       203
       -
           / t.file_name)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
        
       open Icalendar

     

       2
        
       

     

       3
        
       type event_id = string

     

       4
       +
       

     

       5
       +
       type t = {

     

       6
       +
         calendar_name : string;

     

       7
       +
         file : Eio.Fs.dir_ty Eio.Path.t;

     

       8
       +
         event : event;

     

       9
       +
         calendar : calendar;

     

       10
       +
       }

     

       11
       +
       

     

       12
        
       type date_error = [ `Msg of string ]

     

       13
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       14
        
       let generate_uuid () =

     

       15
        
         let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) () in

     

       16
        
         Uuidm.to_string uuid

     

       17
        
       

     

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

     

       19
       +
       let ( let* ) = Result.bind

     

       20
       +
       

     

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

     

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

     

       23
        
         let uuid = generate_uuid () in

     

       24
        
         let uid = (Params.empty, uuid) in

     

       25
        
         let file_name = uuid ^ ".ics" in

     

       26
       +
         let file =

     

       27
       +
           Eio.Path.(

     

       28
       +
             fs / calendar_dir_path / (match calendar_name with s -> s) / file_name)

     

       29
       +
         in

     

       30
       +
         let dtstart = start in

     

       31
       +
         let dtend_or_duration = end_ in

     

       32
       +
         let* _ =

     

       33
       +
           match (dtstart, dtend_or_duration) with

     

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

     

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

     

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

     

       37
       +
               Error

     

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

     

       39
       +
           | _ -> Ok ()

     

       40
        
         in

     

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

     

       42
        
         let now = Ptime_clock.now () in

     
···

       51
        
           | Some desc -> `Description (Params.empty, desc) :: props

     

       52
        
           | None -> props

     

       53
        
         in

     

       54
       +
         let event =

     

       55
        
           {

     

       56
        
             dtstamp = (Params.empty, now);

     

       57
        
             uid;

     
···

       62
        
             alarms = [];

     

       63
        
           }

     

       64
        
         in

     

       65
       +
         let calendar =

     

       66
       +
           let props = [ default_prodid ] in

     

       67
       +
           let components = [ `Event event ] in

     

       68
       +
           (props, components)

     

       69
       +
         in

     

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

     

       71
        
       

     

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

     

       73
        
         let now = Ptime_clock.now () in

     

       74
       +
         let uid = t.event.uid in

     

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

     

       76
       +
         let dtend_or_duration =

     

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

     

       0
        
       
     

       78
        
         in

     

       79
       +
         let* _ =

     

       80
       +
           match (dtstart, dtend_or_duration) with

     

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

     

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

     

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

     

       84
       +
               Error

     

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

     

       86
       +
           | _ -> Ok ()

     

       87
        
         in

     

       88
        
         let rrule =

     

       89
        
           match recurrence with

     

       90
       +
           | None -> t.event.rrule

     

       91
        
           | Some r -> Some (Params.empty, r)

     

       92
        
         in

     

       93
        
         let props =

     
···

       98
        
               | `Description _ -> (

     

       99
        
                   match description with None -> true | Some _ -> false)

     

       100
        
               | _ -> true)

     

       101
       +
             t.event.props

     

       102
        
         in

     

       103
        
         let props =

     

       104
        
           match summary with

     
···

       115
        
           | Some desc -> `Description (Params.empty, desc) :: props

     

       116
        
           | None -> props

     

       117
        
         in

     

       118
       +
         let alarms = t.event.alarms in

     

       119
       +
         let event =

     

       120
        
           {

     

       121
        
             dtstamp = (Params.empty, now);

     

       122
        
             uid;

     
···

       127
        
             alarms;

     

       128
        
           }

     

       129
        
         in

     

       130
       +
         let calendar_name = t.calendar_name in

     

       131
       +
         let file = t.file in

     

       132
       +
         let calendar = t.calendar in

     

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

     

       134
        
       

     

       135
       +
       let events_of_icalendar calendar_name ~file calendar =

     

       136
       +
         let remove_dup_ids lst =

     

       137
       +
           let rec aux acc = function

     

       138
       +
             | [] -> acc

     

       139
       +
             | x :: xs ->

     

       140
       +
                 if List.exists (fun r -> r.uid = x.uid) acc then aux acc xs

     

       141
       +
                 else aux (x :: acc) xs

     

       142
       +
           in

     

       143
       +
           aux [] lst

     

       144
       +
         in

     

       145
       +
         let events =

     

       146
       +
           List.filter_map

     

       147
       +
             (function `Event event -> Some event | _ -> None)

     

       148
       +
             (snd calendar)

     

       149
       +
         in

     

       150
       +
         let events = remove_dup_ids events in

     

       151
       +
         List.map (function event -> { calendar_name; file; event; calendar }) events

     

       152
        
       

     

       153
       +
       let to_ical_event t = t.event

     

       154
       +
       let to_ical_calendar t = t.calendar

     

       155
       +
       let get_id t = snd t.event.uid

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       156
        
       

     

       157
        
       let get_summary t =

     

       158
        
         match

     

       159
        
           List.filter_map

     

       160
        
             (function `Summary (_, s) when s <> "" -> Some s | _ -> None)

     

       161
       +
             t.event.props

     

       162
        
         with

     

       163
        
         | s :: _ -> Some s

     

       164
        
         | _ -> None

     

       165
        
       

     

       166
       +
       let get_ical_start event = Date.ptime_of_ical (snd event.dtstart)

     

       167
       +
       let get_start t = get_ical_start t.event

     

       168
        
       

     

       169
       +
       let get_ical_end event =

     

       170
       +
         match event.dtend_or_duration with

     

       171
       +
         | Some (`Dtend (_, d)) -> Some (Date.ptime_of_ical d)

     

       172
        
         | Some (`Duration (_, span)) -> (

     

       173
       +
             let start = get_ical_start event in

     

       174
        
             match Ptime.add_span start span with

     

       175
        
             | Some t -> Some t

     

       176
        
             | None ->

     
···

       180
        
                      (Printf.sprintf "%.2fs" (Ptime.Span.to_float_s span))))

     

       181
        
         | None -> None

     

       182
        
       

     

       183
       +
       let get_end t = get_ical_end t.event

     

       184
       +
       

     

       185
       +
       let get_start_timezone t =

     

       186
       +
         match t.event.dtstart with

     

       187
       +
         | _, `Datetime (`With_tzid (_, (_, tzid))) -> Some tzid

     

       188
       +
         | _, `Datetime (`Utc _) -> Some "UTC"

     

       189
       +
         | _ -> None

     

       190
       +
       

     

       191
       +
       let get_end_timezone t =

     

       192
       +
         match t.event.dtend_or_duration with

     

       193
       +
         | Some (`Dtend (_, `Datetime (`With_tzid (_, (_, tzid))))) -> Some tzid

     

       194
       +
         | Some (`Dtend (_, `Datetime (`Utc _))) -> Some "UTC"

     

       195
       +
         | _ -> None

     

       196
       +
       

     

       197
        
       let get_duration t =

     

       198
       +
         match t.event.dtend_or_duration with

     

       199
        
         | Some (`Duration (_, span)) -> Some span

     

       200
        
         | Some (`Dtend (_, e)) ->

     

       201
       +
             let span = Ptime.diff (Date.ptime_of_ical e) (get_start t) in

     

       202
        
             Some span

     

       203
        
         | None -> None

     

       204
        
       

     

       205
       +
       let is_date t =

     

       206
       +
         match (t.event.dtstart, t.event.dtend_or_duration) with

     

       207
        
         | (_, `Date _), _ -> true

     

       208
        
         | _, Some (`Dtend (_, `Date _)) -> true

     

       209
        
         | _ -> false

     
···

       212
        
         match

     

       213
        
           List.filter_map

     

       214
        
             (function `Location (_, s) when s <> "" -> Some s | _ -> None)

     

       215
       +
             t.event.props

     

       216
        
         with

     

       217
        
         | s :: _ -> Some s

     

       218
        
         | _ -> None

     
···

       221
        
         match

     

       222
        
           List.filter_map

     

       223
        
             (function `Description (_, s) when s <> "" -> Some s | _ -> None)

     

       224
       +
             t.event.props

     

       225
        
         with

     

       226
        
         | s :: _ -> Some s

     

       227
        
         | _ -> None

     

       228
        
       

     

       229
       +
       let get_recurrence t = Option.map (fun r -> snd r) t.event.rrule

     

       230
       +
       let get_calendar_name t = t.calendar_name

     

       231
       +
       let get_file t = t.file

     

       232
       +
       

     

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

     

       234
        
       

     

       235
       +
       let by_start e1 e2 =

     

       236
       +
         let t1 = get_start e1 in

     

       237
       +
         let t2 = get_start e2 in

     

       238
       +
         Ptime.compare t1 t2

     

       239
       +
       

     

       240
       +
       let by_end e1 e2 =

     

       241
       +
         match (get_end e1, get_end e2) with

     

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

     

       243
       +
         | Some _, None -> 1

     

       244
       +
         | None, Some _ -> -1

     

       245
       +
         | None, None -> 0

     

       246
       +
       

     

       247
       +
       let by_summary e1 e2 =

     

       248
       +
         match (get_summary e1, get_summary e2) with

     

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

     

       250
       +
         | Some _, None -> 1

     

       251
       +
         | None, Some _ -> -1

     

       252
       +
         | None, None -> 0

     

       253
       +
       

     

       254
       +
       let by_location e1 e2 =

     

       255
       +
         match (get_location e1, get_location e2) with

     

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

     

       257
       +
         | Some _, None -> 1

     

       258
       +
         | None, Some _ -> -1

     

       259
       +
         | None, None -> 0

     

       260
       +
       

     

       261
       +
       let by_calendar_name e1 e2 =

     

       262
       +
         match (get_calendar_name e1, get_calendar_name e2) with

     

       263
       +
         | c1, c2 -> String.compare c1 c2

     

       264
       +
       

     

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

     

       266
       +
       

     

       267
       +
       let chain comp1 comp2 e1 e2 =

     

       268
       +
         let result = comp1 e1 e2 in

     

       269
       +
         if result <> 0 then result else comp2 e1 e2

     

       270
       +
       

     

       271
       +
       let clone_with_event t event =

     

       272
       +
         let calendar_name = t.calendar_name in

     

       273
       +
         let file = t.file in

     

       274
       +
         let calendar = t.calendar in

     

       275
       +
         { calendar_name; file; event; calendar }

     

       276
       +
       

     

       277
       +
       type format = [ `Text | `Entries | `Json | `Csv | `Ics | `Sexp ]

     

       278
       +
       

     

       279
       +
       let format_date ?tz date =

     

       280
       +
         let dt = Date.ptime_to_timedesc ?tz date in

     

       281
       +
         let y = Timedesc.year dt in

     

       282
       +
         let m = Timedesc.month dt in

     

       283
       +
         let d = Timedesc.day dt in

     

       284
       +
         let weekday =

     

       285
       +
           match Timedesc.weekday dt with

     

       286
       +
           | `Mon -> "Mon"

     

       287
       +
           | `Tue -> "Tue"

     

       288
       +
           | `Wed -> "Wed"

     

       289
       +
           | `Thu -> "Thu"

     

       290
       +
           | `Fri -> "Fri"

     

       291
       +
           | `Sat -> "Sat"

     

       292
       +
           | `Sun -> "Sun"

     

       293
       +
         in

     

       294
       +
         Printf.sprintf "%04d-%02d-%02d %s" y m d weekday

     

       295
       +
       

     

       296
       +
       let format_time ?tz date =

     

       297
       +
         let dt = Date.ptime_to_timedesc ?tz date in

     

       298
       +
         let h = Timedesc.hour dt in

     

       299
       +
         let m = Timedesc.minute dt in

     

       300
       +
         Printf.sprintf "%02d:%02d" h m

     

       301
       +
       

     

       302
       +
       let format_datetime ?tz date =

     

       303
       +
         let tz_str =

     

       304
       +
           match tz with

     

       305
       +
           | Some tz -> Printf.sprintf "(%s)" (Timedesc.Time_zone.name tz)

     

       306
       +
           | None -> ""

     

       307
       +
         in

     

       308
       +
         Printf.sprintf "%s %s%s" (format_date ?tz date) (format_time ?tz date) tz_str

     

       309
       +
       

     

       310
       +
       let day_diff day ~next =

     

       311
       +
         let span = Ptime.diff next day in

     

       312
       +
         let d, _ = Ptime.Span.to_d_ps span in

     

       313
       +
         d

     

       314
       +
       

     

       315
       +
       (* exosed from icalendar *)

     

       316
       +
       

     

       317
       +
       let weekday_strings =

     

       318
       +
         [

     

       319
       +
           (`Monday, "MO");

     

       320
       +
           (`Tuesday, "TU");

     

       321
       +
           (`Wednesday, "WE");

     

       322
       +
           (`Thursday, "TH");

     

       323
       +
           (`Friday, "FR");

     

       324
       +
           (`Saturday, "SA");

     

       325
       +
           (`Sunday, "SU");

     

       326
       +
         ]

     

       327
       +
       

     

       328
       +
       let freq_strings =

     

       329
       +
         [

     

       330
       +
           (`Daily, "DAILY");

     

       331
       +
           (`Hourly, "HOURLY");

     

       332
       +
           (`Minutely, "MINUTELY");

     

       333
       +
           (`Monthly, "MONTHLY");

     

       334
       +
           (`Secondly, "SECONDLY");

     

       335
       +
           (`Weekly, "WEEKLY");

     

       336
       +
           (`Yearly, "YEARLY");

     

       337
       +
         ]

     

       338
       +
       

     

       339
       +
       let date_to_str (y, m, d) = Printf.sprintf "%04d%02d%02d" y m d

     

       340
       +
       

     

       341
       +
       let datetime_to_str ptime utc =

     

       342
       +
         let date, ((hh, mm, ss), _) = Ptime.to_date_time ptime in

     

       343
       +
         Printf.sprintf "%sT%02d%02d%02d%s" (date_to_str date) hh mm ss

     

       344
       +
           (if utc then "Z" else "")

     

       345
       +
       

     

       346
       +
       let timestamp_to_ics ts buf =

     

       347
       +
         Buffer.add_string buf

     

       348
       +
         @@

     

       349
       +
         match ts with

     

       350
       +
         | `Utc ts -> datetime_to_str ts true

     

       351
       +
         | `Local ts -> datetime_to_str ts false

     

       352
       +
         | `With_tzid (ts, _str) -> (* TODO *) datetime_to_str ts false

     

       353
       +
       

     

       354
       +
       let recurs_to_ics (freq, count_or_until, interval, l) buf =

     

       355
       +
         let write_rulepart key value =

     

       356
       +
           Buffer.add_string buf key;

     

       357
       +
           Buffer.add_char buf '=';

     

       358
       +
           Buffer.add_string buf value

     

       359
       +
         in

     

       360
       +
         let int_list l = String.concat "," @@ List.map string_of_int l in

     

       361
       +
         let recur_to_ics = function

     

       362
       +
           | `Byminute byminlist -> write_rulepart "BYMINUTE" (int_list byminlist)

     

       363
       +
           | `Byday bywdaylist ->

     

       364
       +
               let wday (weeknumber, weekday) =

     

       365
       +
                 (if weeknumber = 0 then "" else string_of_int weeknumber)

     

       366
       +
                 ^ List.assoc weekday weekday_strings

     

       367
       +
               in

     

       368
       +
               write_rulepart "BYDAY" (String.concat "," @@ List.map wday bywdaylist)

     

       369
       +
           | `Byhour byhrlist -> write_rulepart "BYHOUR" (int_list byhrlist)

     

       370
       +
           | `Bymonth bymolist -> write_rulepart "BYMONTH" (int_list bymolist)

     

       371
       +
           | `Bymonthday bymodaylist ->

     

       372
       +
               write_rulepart "BYMONTHDAY" (int_list bymodaylist)

     

       373
       +
           | `Bysecond byseclist -> write_rulepart "BYSECOND" (int_list byseclist)

     

       374
       +
           | `Bysetposday bysplist -> write_rulepart "BYSETPOS" (int_list bysplist)

     

       375
       +
           | `Byweek bywknolist -> write_rulepart "BYWEEKNO" (int_list bywknolist)

     

       376
       +
           | `Byyearday byyrdaylist ->

     

       377
       +
               write_rulepart "BYYEARDAY" (int_list byyrdaylist)

     

       378
       +
           | `Weekday weekday ->

     

       379
       +
               write_rulepart "WKST" (List.assoc weekday weekday_strings)

     

       380
       +
         in

     

       381
       +
         write_rulepart "FREQ" (List.assoc freq freq_strings);

     

       382
       +
         (match count_or_until with

     

       383
       +
         | None -> ()

     

       384
       +
         | Some x -> (

     

       385
       +
             Buffer.add_char buf ';';

     

       386
       +
             match x with

     

       387
       +
             | `Count c -> write_rulepart "COUNT" (string_of_int c)

     

       388
       +
             | `Until enddate ->

     

       389
       +
                 (* TODO cleanup *)

     

       390
       +
                 Buffer.add_string buf "UNTIL=";

     

       391
       +
                 timestamp_to_ics enddate buf));

     

       392
       +
         (match interval with

     

       393
       +
         | None -> ()

     

       394
       +
         | Some i ->

     

       395
       +
             Buffer.add_char buf ';';

     

       396
       +
             write_rulepart "INTERVAL" (string_of_int i));

     

       397
       +
         List.iter

     

       398
       +
           (fun recur ->

     

       399
       +
             Buffer.add_char buf ';';

     

       400
       +
             recur_to_ics recur)

     

       401
       +
           l

     

       402
       +
       

     

       403
       +
       let text_event_data ?tz event =

     

       404
       +
         let id = get_id event in

     

       405
       +
         let start = get_start event in

     

       406
       +
         let end_ = get_end event in

     

       407
       +
         let start_date = format_date ?tz start in

     

       408
       +
         let start_timezone = get_start_timezone event in

     

       409
       +
         let end_timezone = get_end_timezone event in

     

       410
       +
         let same_timezone =

     

       411
       +
           match (start_timezone, end_timezone) with

     

       412
       +
           | Some tz1, Some tz2 when tz1 = tz2 -> true

     

       413
       +
           | _ -> false

     

       414
       +
         in

     

       415
       +
         let start_time =

     

       416
       +
           match is_date event with

     

       417
       +
           | true -> ""

     

       418
       +
           | false ->

     

       419
       +
               let tz_str =

     

       420
       +
                 if same_timezone then " " ^ format_time ?tz start

     

       421
       +
                 else

     

       422
       +
                   match start_timezone with

     

       423
       +
                   | Some tzid -> " " ^ format_time ?tz start ^ " (" ^ tzid ^ ")"

     

       424
       +
                   | None -> " " ^ format_time ?tz start

     

       425
       +
               in

     

       426
       +
               tz_str

     

       427
       +
         in

     

       428
       +
         let end_date, end_time =

     

       429
       +
           match end_ with

     

       430
       +
           | None -> ("", "")

     

       431
       +
           | Some end_ -> (

     

       432
       +
               match is_date event with

     

       433
       +
               | true -> (

     

       434
       +
                   match day_diff start ~next:end_ <= 1 with

     

       435
       +
                   | true -> ("", "")

     

       436
       +
                   | false -> (" - " ^ format_date ?tz end_, ""))

     

       437
       +
               | false -> (

     

       438
       +
                   match day_diff start ~next:end_ == 0 with

     

       439
       +
                   | true ->

     

       440
       +
                       let tz_str =

     

       441
       +
                         match end_timezone with

     

       442
       +
                         | Some tzid when same_timezone ->

     

       443
       +
                             ("", " - " ^ format_time ?tz end_ ^ " (" ^ tzid ^ ")")

     

       444
       +
                         | Some tzid ->

     

       445
       +
                             ("", " - " ^ format_time ?tz end_ ^ " (" ^ tzid ^ ")")

     

       446
       +
                         | None -> ("", " - " ^ format_time ?tz end_)

     

       447
       +
                       in

     

       448
       +
                       tz_str

     

       449
       +
                   | false ->

     

       450
       +
                       let tz_str =

     

       451
       +
                         match end_timezone with

     

       452
       +
                         | Some tzid when same_timezone ->

     

       453
       +
                             ( " - " ^ format_date ?tz end_,

     

       454
       +
                               " " ^ format_time ?tz end_ ^ " (" ^ tzid ^ ")" )

     

       455
       +
                         | Some tzid ->

     

       456
       +
                             ( " - " ^ format_date ?tz end_,

     

       457
       +
                               " " ^ format_time ?tz end_ ^ " (" ^ tzid ^ ")" )

     

       458
       +
                         | None ->

     

       459
       +
                             (" - " ^ format_date ?tz end_, " " ^ format_time ?tz end_)

     

       460
       +
                       in

     

       461
       +
                       tz_str))

     

       462
       +
         in

     

       463
       +
         let summary =

     

       464
       +
           match get_summary event with

     

       465
       +
           | Some summary when summary <> "" -> summary

     

       466
       +
           | _ -> ""

     

       467
       +
         in

     

       468
       +
         let location =

     

       469
       +
           match get_location event with

     

       470
       +
           | Some loc when loc <> "" -> "@" ^ loc

     

       471
       +
           | _ -> ""

     

       472
       +
         in

     

       473
       +
         let calendar_name = get_calendar_name event in

     

       474
       +
         let date_time = start_date ^ start_time ^ end_date ^ end_time in

     

       475
       +
         (id, calendar_name, date_time, summary, location)

     

       476
       +
       

     

       477
       +
       let format_event ?(format = `Text) ?tz event =

     

       478
       +
         let start = get_start event in

     

       479
       +
         let end_ = get_end event in

     

       480
       +
         match format with

     

       481
       +
         | `Text ->

     

       482
       +
             let id, calendar_name, date_time, summary, location =

     

       483
       +
               text_event_data ?tz event

     

       484
       +
             in

     

       485
       +
             Printf.sprintf "%s\t%s\t%s\t%s\t%s" calendar_name date_time summary

     

       486
       +
               location id

     

       487
       +
         | `Entries ->

     

       488
       +
             let format_opt label f opt =

     

       489
       +
               Option.map (fun x -> Printf.sprintf "%s: %s\n" label (f x)) opt

     

       490
       +
               |> Option.value ~default:""

     

       491
       +
             in

     

       492
       +
             let start_timezone = get_start_timezone event in

     

       493
       +
             let end_timezone = get_end_timezone event in

     

       494
       +
             let same_timezone =

     

       495
       +
               match (start_timezone, end_timezone) with

     

       496
       +
               | Some tz1, Some tz2 when tz1 = tz2 -> true

     

       497
       +
               | _ -> false

     

       498
       +
             in

     

       499
       +
             let format timezone datetime is_end =

     

       500
       +
               match is_date event with

     

       501
       +
               | true -> format_date ?tz datetime

     

       502
       +
               | false ->

     

       503
       +
                   let tz_suffix =

     

       504
       +
                     if (not is_end) && same_timezone then ""

     

       505
       +
                     else match timezone with None -> "" | Some t -> " (" ^ t ^ ")"

     

       506
       +
                   in

     

       507
       +
                   format_datetime ?tz datetime ^ tz_suffix

     

       508
       +
             in

     

       509
       +
             let start_str =

     

       510
       +
               format_opt "Start" (fun d -> format start_timezone d false) (Some start)

     

       511
       +
             in

     

       512
       +
             let end_str =

     

       513
       +
               format_opt "End" (fun d -> format end_timezone d true) end_

     

       514
       +
             in

     

       515
       +
             let location_str = format_opt "Location" Fun.id (get_location event) in

     

       516
       +
             let description_str =

     

       517
       +
               format_opt "Description" Fun.id (get_description event)

     

       518
       +
             in

     

       519
       +
             let rrule_str =

     

       520
       +
               Option.map

     

       521
       +
                 (fun r ->

     

       522
       +
                   let buf = Buffer.create 128 in

     

       523
       +
                   recurs_to_ics r buf;

     

       524
       +
                   Printf.sprintf "%s: %s\n" "Reccurence" (Buffer.contents buf))

     

       525
       +
                 (get_recurrence event)

     

       526
       +
               |> Option.value ~default:""

     

       527
       +
             in

     

       528
       +
             let summary_str = format_opt "Summary" Fun.id (get_summary event) in

     

       529
       +
             let file_str = format_opt "File" Fun.id (Some (snd (get_file event))) in

     

       530
       +
             Printf.sprintf "%s%s%s%s%s%s%s" summary_str start_str end_str location_str

     

       531
       +
               description_str rrule_str file_str

     

       532
       +
         | `Json ->

     

       533
       +
             let open Yojson.Safe in

     

       534
       +
             let json =

     

       535
       +
               `Assoc

     

       536
       +
                 [

     

       537
       +
                   ("id", `String (get_id event));

     

       538
       +
                   ( "summary",

     

       539
       +
                     match get_summary event with

     

       540
       +
                     | Some summary -> `String summary

     

       541
       +
                     | None -> `Null );

     

       542
       +
                   ("start", `String (format_datetime ?tz start));

     

       543
       +
                   ( "end",

     

       544
       +
                     match end_ with

     

       545
       +
                     | Some e -> `String (format_datetime ?tz e)

     

       546
       +
                     | None -> `Null );

     

       547
       +
                   ( "location",

     

       548
       +
                     match get_location event with

     

       549
       +
                     | Some loc -> `String loc

     

       550
       +
                     | None -> `Null );

     

       551
       +
                   ( "description",

     

       552
       +
                     match get_description event with

     

       553
       +
                     | Some desc -> `String desc

     

       554
       +
                     | None -> `Null );

     

       555
       +
                   ("calendar", match get_calendar_name event with cal -> `String cal);

     

       556
       +
                 ]

     

       557
       +
             in

     

       558
       +
             to_string json

     

       559
       +
         | `Csv ->

     

       560
       +
             let summary =

     

       561
       +
               match get_summary event with Some summary -> summary | None -> ""

     

       562
       +
             in

     

       563
       +
             let start = format_datetime ?tz start in

     

       564
       +
             let end_str =

     

       565
       +
               match end_ with Some e -> format_datetime ?tz e | None -> ""

     

       566
       +
             in

     

       567
       +
             let location =

     

       568
       +
               match get_location event with Some loc -> loc | None -> ""

     

       569
       +
             in

     

       570
       +
             let cal_id = match get_calendar_name event with cal -> cal in

     

       571
       +
             Printf.sprintf "\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" summary start end_str

     

       572
       +
               location cal_id

     

       573
       +
         | `Ics ->

     

       574
       +
             let calendar = to_ical_calendar event in

     

       575
       +
             Icalendar.to_ics ~cr:true calendar

     

       576
       +
         | `Sexp ->

     

       577
       +
             let summary =

     

       578
       +
               match get_summary event with Some summary -> summary | None -> ""

     

       579
       +
             in

     

       580
       +
             let start_str =

     

       581
       +
               let dt = Date.ptime_to_timedesc ?tz start in

     

       582
       +
               let y = Timedesc.year dt in

     

       583
       +
               let m = Timedesc.month dt in

     

       584
       +
               let d = Timedesc.day dt in

     

       585
       +
               let h = Timedesc.hour dt in

     

       586
       +
               let min = Timedesc.minute dt in

     

       587
       +
               let s = Timedesc.second dt in

     

       588
       +
               (* Format as a single timestamp string that's easy for Emacs to parse *)

     

       589
       +
               Printf.sprintf "\"%04d-%02d-%02dT%02d:%02d:%02d\"" y m d h min s

     

       590
       +
             in

     

       591
       +
             let end_str =

     

       592
       +
               match end_ with

     

       593
       +
               | Some end_date ->

     

       594
       +
                   let dt = Date.ptime_to_timedesc ?tz end_date in

     

       595
       +
                   let y = Timedesc.year dt in

     

       596
       +
                   let m = Timedesc.month dt in

     

       597
       +
                   let d = Timedesc.day dt in

     

       598
       +
                   let h = Timedesc.hour dt in

     

       599
       +
                   let min = Timedesc.minute dt in

     

       600
       +
                   let s = Timedesc.second dt in

     

       601
       +
                   Printf.sprintf "\"%04d-%02d-%02dT%02d:%02d:%02d\"" y m d h min s

     

       602
       +
               | None -> "nil"

     

       603
       +
             in

     

       604
       +
             let location =

     

       605
       +
               match get_location event with

     

       606
       +
               | Some loc -> Printf.sprintf "\"%s\"" (String.escaped loc)

     

       607
       +
               | None -> "nil"

     

       608
       +
             in

     

       609
       +
             let description =

     

       610
       +
               match get_description event with

     

       611
       +
               | Some desc -> Printf.sprintf "\"%s\"" (String.escaped desc)

     

       612
       +
               | None -> "nil"

     

       613
       +
             in

     

       614
       +
             let calendar =

     

       615
       +
               match get_calendar_name event with

     

       616
       +
               | cal -> Printf.sprintf "\"%s\"" (String.escaped cal)

     

       617
       +
             in

     

       618
       +
             let id = get_id event in

     

       619
       +
             Printf.sprintf

     

       620
       +
               "((:id \"%s\" :summary \"%s\" :start %s :end %s :location %s \

     

       621
       +
                :description %s :calendar %s))"

     

       622
       +
               (String.escaped id) (String.escaped summary) start_str end_str location

     

       623
       +
               description calendar

     

       624
       +
       

     

       625
       +
       let format_events_with_dynamic_columns ?tz events =

     

       626
       +
         if events = [] then ""

     

       627
       +
         else

     

       628
       +
           let event_data = List.map (text_event_data ?tz) events in

     

       629
       +
           (* Calculate max width for each column *)

     

       630
       +
           let max_id_width =

     

       631
       +
             List.fold_left

     

       632
       +
               (fun acc (id, _, _, _, _) -> max acc (String.length id))

     

       633
       +
               0 event_data

     

       634
       +
           in

     

       635
       +
           let max_cal_width =

     

       636
       +
             List.fold_left

     

       637
       +
               (fun acc (_, cal, _, _, _) -> max acc (String.length cal))

     

       638
       +
               0 event_data

     

       639
       +
           in

     

       640
       +
           let max_date_width =

     

       641
       +
             List.fold_left

     

       642
       +
               (fun acc (_, _, date, _, _) -> max acc (String.length date))

     

       643
       +
               0 event_data

     

       644
       +
           in

     

       645
       +
           (* Calculate max width for summary+location *)

     

       646
       +
           let max_summary_loc_width =

     

       647
       +
             List.fold_left

     

       648
       +
               (fun acc (_, _, _, summary, location) ->

     

       649
       +
                 let full_length =

     

       650
       +
                   String.length summary

     

       651
       +
                   + if location <> "" then String.length location + 1 else 0

     

       652
       +
                 in

     

       653
       +
                 max acc full_length)

     

       654
       +
               0 event_data

     

       655
       +
           in

     

       656
       +
           (* Format each event with calculated widths *)

     

       657
       +
           let formatted_events =

     

       658
       +
             List.map

     

       659
       +
               (fun (id, cal, date, summary, location) ->

     

       660
       +
                 let summary_loc =

     

       661
       +
                   summary ^ if location <> "" then " " ^ location else ""

     

       662
       +
                 in

     

       663
       +
                 Printf.sprintf "%-*s  %-*s  %-*s  %-*s" max_cal_width cal

     

       664
       +
                   max_date_width date max_summary_loc_width summary_loc max_id_width

     

       665
       +
                   id)

     

       666
       +
               event_data

     

       667
       +
           in

     

       668
       +
           String.concat "\n" formatted_events

     

       669
       +
       

     

       670
       +
       let format_events ?(format = `Text) ?tz events =

     

       671
       +
         match format with

     

       672
       +
         | `Json ->

     

       673
       +
             let json_events =

     

       674
       +
               List.map

     

       675
       +
                 (fun e -> Yojson.Safe.from_string (format_event ~format:`Json ?tz e))

     

       676
       +
                 events

     

       677
       +
             in

     

       678
       +
             Yojson.Safe.to_string (`List json_events)

     

       679
       +
         | `Csv ->

     

       680
       +
             "\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"

     

       681
       +
             ^ String.concat "\n" (List.map (format_event ~format:`Csv ?tz) events)

     

       682
       +
         | `Sexp ->

     

       683
       +
             "("

     

       684
       +
             ^ String.concat "\n "

     

       685
       +
                 (List.map (fun e -> format_event ~format:`Sexp ?tz e) events)

     

       686
       +
             ^ ")"

     

       687
       +
         | `Text -> format_events_with_dynamic_columns ?tz events

     

       688
       +
         | _ ->

     

       689
       +
             String.concat "\n" (List.map (fun e -> format_event ~format ?tz e) events)

     

       690
       +
       

     

       691
       +
       let expand_recurrences ~from ~to_ event =

     

       692
       +
         let rule = get_recurrence event in

     

       693
       +
         match rule with

     

       694
       +
         (* If there's no recurrence we just return the original event. *)

     

       695
       +
         | None ->

     

       696
       +
             (* Include the original event instance only if it falls within the query range. *)

     

       697
       +
             let start = get_start event in

     

       698
       +
             let end_ = match get_end event with None -> start | Some e -> e in

     

       699
       +
             if

     

       700
       +
               Ptime.compare start to_ < 0

     

       701
       +
               &&

     

       702
       +
               (* end_ > f, meaning we don't include events that end at the exact start of our range.

     

       703
       +
                  This is handy to exclude date events that end at 00:00 the next day. *)

     

       704
       +
               match from with Some f -> Ptime.compare end_ f > 0 | None -> true

     

       705
       +
             then [ event ]

     

       706
       +
             else []

     

       707
       +
         | Some _ ->

     

       708
       +
             let rec collect generator acc =

     

       709
       +
               match generator () with

     

       710
       +
               | None -> List.rev acc

     

       711
       +
               | Some recur ->

     

       712
       +
                   let start = get_ical_start recur in

     

       713
       +
                   let end_ =

     

       714
       +
                     match get_ical_end recur with None -> start | Some e -> e

     

       715
       +
                   in

     

       716
       +
                   (* if start >= to then we're outside our (exclusive) date range and we terminate *)

     

       717
       +
                   if Ptime.compare start to_ >= 0 then List.rev acc

     

       718
       +
                     (* if end > from then, *)

     

       719
       +
                   else if

     

       720
       +
                     match from with

     

       721
       +
                     | Some f -> Ptime.compare end_ f > 0

     

       722
       +
                     | None -> true

     

       723
       +
                   (* we include the event *)

     

       724
       +
                   then collect generator (clone_with_event event recur :: acc)

     

       725
       +
                   (* otherwise we iterate till the event is in range *)

     

       726
       +
                     else collect generator acc

     

       727
       +
             in

     

       728
       +
             let generator =

     

       729
       +
               let ical_event = to_ical_event event in

     

       730
       +
               (* The first event is the non recurrence-id one *)

     

       731
       +
               let _, other_events =

     

       732
       +
                 match

     

       733
       +
                   List.partition

     

       734
       +
                     (function `Event _ -> true | _ -> false)

     

       735
       +
                     (snd event.calendar)

     

       736
       +
                 with

     

       737
       +
                 | `Event hd :: tl, _ ->

     

       738
       +
                     (hd, List.map (function `Event e -> e | _ -> assert false) tl)

     

       739
       +
                 | _ -> assert false

     

       740
       +
               in

     

       741
       +
               recur_events ~recurrence_ids:other_events ical_event

     

       742
       +
             in

     

       743
       +
             collect generator []

     

       744
       +
       

     

       745
       +
       let sexp_of_t event =

     

       746
       +
         let open Sexplib.Sexp in

     

       747
       +
         let start = get_start event in

     

       748
       +
         let end_ = get_end event in

     

       749
       +
         let format_ptime_iso p =

     

       750
       +
           let dt = Date.ptime_to_timedesc p in

     

       751
       +
           let y = Timedesc.year dt in

     

       752
       +
           let m = Timedesc.month dt in

     

       753
       +
           let d = Timedesc.day dt in

     

       754
       +
           let h = Timedesc.hour dt in

     

       755
       +
           let min = Timedesc.minute dt in

     

       756
       +
           let s = Timedesc.second dt in

     

       757
       +
           Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02d" y m d h min s

     

       758
       +
         in

     

       759
       +
         let entries =

     

       760
       +
           [

     

       761
       +
             Some (List [ Atom "id"; Atom (get_id event) ]);

     

       762
       +
             (match get_summary event with

     

       763
       +
             | Some s -> Some (List [ Atom "summary"; Atom s ])

     

       764
       +
             | None -> None);

     

       765
       +
             Some (List [ Atom "start"; Atom (format_ptime_iso start) ]);

     

       766
       +
             (match end_ with

     

       767
       +
             | Some e -> Some (List [ Atom "end"; Atom (format_ptime_iso e) ])

     

       768
       +
             | None -> None);

     

       769
       +
             (match get_location event with

     

       770
       +
             | Some l -> Some (List [ Atom "location"; Atom l ])

     

       771
       +
             | None -> None);

     

       772
       +
             (match get_description event with

     

       773
       +
             | Some d -> Some (List [ Atom "description"; Atom d ])

     

       774
       +
             | None -> None);

     

       775
       +
             Some (List [ Atom "file"; Atom (snd (get_file event)) ]);

     

       776
       +
             Some (List [ Atom "calendar"; Atom (get_calendar_name event) ]);

     

       777
       +
           ]

     

       778
       +
         in

     

       779
       +
         let filtered_entries = List.filter_map Fun.id entries in

     

       780
       +
         List filtered_entries

     

       781
       +
       

     

       782
       +
       type filter = t -> bool

     

       783
       +
       

     

       784
       +
       let text_matches pattern text =

     

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

     

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

     

       787
       +
       

     

       788
       +
       let summary_contains text event =

     

       789
       +
         match get_summary event with

     

       790
       +
         | Some summary -> text_matches text summary

     

       791
       +
         | None -> false

     

       792
       +
       

     

       793
       +
       let description_contains text event =

     

       794
       +
         match get_description event with

     

       795
       +
         | Some desc -> text_matches text desc

     

       796
       +
         | None -> false

     

       797
       +
       

     

       798
       +
       let location_contains text event =

     

       799
       +
         match get_location event with

     

       800
       +
         | Some loc -> text_matches text loc

     

       801
       +
         | None -> false

     

       802
       +
       

     

       803
       +
       let in_calendars ids event =

     

       804
       +
         let id = get_calendar_name event in

     

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

     

       806
       +
       

     

       807
       +
       let recurring_only () event = get_recurrence event <> None

     

       808
       +
       let non_recurring_only () event = get_recurrence event = None

     

       809
       +
       let with_id id event = get_id event = id

     

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

     

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

     

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

     

       813
       +
       let matches_filter event filter = filter event

     

       814
       +
       

     

       815
       +
       let take n list =

     

       816
       +
         let rec aux n lst acc =

     

       817
       +
           match (lst, n) with

     

       818
       +
           | _, 0 -> List.rev acc

     

       819
       +
           | [], _ -> List.rev acc

     

       820
       +
           | x :: xs, n -> aux (n - 1) xs (x :: acc)

     

       821
       +
         in

     

       822
       +
         aux n list []

     

       823
       +
       

     

       824
       +
       let query_without_recurrence events ?filter ?(comparator = by_start) ?limit () =

     

       825
       +
         let events =

     

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

     

       827
       +
         in

     

       828
       +
         let events = List.sort comparator events in

     

       829
       +
         match limit with Some n when n > 0 -> take n events | _ -> events

     

       830
       +
       

     

       831
       +
       let query events ?filter ~from ~to_ ?comparator ?limit () =

     

       832
       +
         let events =

     

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

     

       834
       +
         in

     

       835
       +
         let events =

     

       836
       +
           List.concat_map (fun event -> expand_recurrences event ~from ~to_) events

     

       837
       +
         in

     

       838
       +
         let events =

     

       839
       +
           match comparator with None -> events | Some c -> List.sort c events

     

       840
       +
         in

     

       841
       +
         match limit with Some n when n > 0 -> take n events | _ -> events

+131 -19

lib/event.mli

···

       7
        
       (** Event type representing a calendar event *)

     

       8
        
       

     

       9
        
       type date_error = [ `Msg of string ]

     

       10
       -
       (** Type for date-related errors *)

     

       0
        
       
     

       11
        
       

     

       12
        
       val create :

     

       0
        
       
     

       0
        
       
     

       13
        
         summary:string ->

     

       14
       -
         start:Ptime.t ->

     

       15
       -
         ?end_:Ptime.t ->

     

       0
        
       
     

       0
        
       
     

       16
        
         ?location:string ->

     

       17
        
         ?description:string ->

     

       18
        
         ?recurrence:Icalendar.recurrence ->

     

       19
       -
         Collection.t ->

     

       20
       -
         t

     

       21
       -
       (** Create a new event with required properties *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       22
        
       

     

       23
        
       val edit :

     

       24
        
         ?summary:string ->

     

       25
       -
         ?start:Ptime.t ->

     

       26
       -
         ?end_:Ptime.t ->

     

       0
        
       
     

       0
        
       
     

       27
        
         ?location:string ->

     

       28
        
         ?description:string ->

     

       29
        
         ?recurrence:Icalendar.recurrence ->

     

       30
        
         t ->

     

       31
       -
         t

     

       32
       -
       (** Edit an existing event *)

     

       33
        
       

     

       34
       -
       val of_icalendar : Collection.t -> file_name:string -> Icalendar.event -> t

     

       35
       -
       (** Convert an Icalendar event to our event type. *)

     

       36
        
       

     

       37
       -
       val to_icalendar : t -> Icalendar.event

     

       38
       -
       (** Convert our event type to an Icalendar event *)

     

       39
       -
       

     

       40
        
       val get_id : t -> event_id

     

       41
        
       val get_summary : t -> string option

     

       0
        
       
     

       42
        
       val get_start : t -> Ptime.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       43
        
       val get_end : t -> Ptime.t option

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       44
        
       val get_duration : t -> Ptime.span option

     

       45
       -
       val get_day_event : t -> bool

     

       46
        
       val get_location : t -> string option

     

       47
        
       val get_description : t -> string option

     

       48
        
       val get_recurrence : t -> Icalendar.recurrence option

     

       49
       -
       val get_collection : t -> Collection.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       50
        
       

     

       51
       -
       val get_file_path :

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       7
        
       (** Event type representing a calendar event *)

     

       8
        
       

     

       9
        
       type date_error = [ `Msg of string ]

     

       10
       +
       

     

       11
       +
       (** {2 Events} *)

     

       12
        
       

     

       13
        
       val create :

     

       14
       +
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       15
       +
         calendar_dir_path:string ->

     

       16
        
         summary:string ->

     

       17
       +
         start:Icalendar.params * Icalendar.date_or_datetime ->

     

       18
       +
         ?end_:

     

       19
       +
           [ `Duration of Icalendar.params * Ptime.Span.t

     

       20
       +
           | `Dtend of Icalendar.params * Icalendar.date_or_datetime ] ->

     

       21
        
         ?location:string ->

     

       22
        
         ?description:string ->

     

       23
        
         ?recurrence:Icalendar.recurrence ->

     

       24
       +
         string ->

     

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

     

       26
       +
       (** Create a new event with required properties.

     

       27
       +
       

     

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

     

       29
       +
           which allows for directly using any of the three RFC5545 time formats:

     

       30
       +
           - `Utc time: Fixed to absolute UTC time

     

       31
       +
           - `Local time: Floating local time (follows user's timezone)

     

       32
       +
           - `With_tzid (time, timezone): Local time with timezone reference *)

     

       33
        
       

     

       34
        
       val edit :

     

       35
        
         ?summary:string ->

     

       36
       +
         ?start:Icalendar.params * Icalendar.date_or_datetime ->

     

       37
       +
         ?end_:

     

       38
       +
           [ `Duration of Icalendar.params * Ptime.Span.t

     

       39
       +
           | `Dtend of Icalendar.params * Icalendar.date_or_datetime ] ->

     

       40
        
         ?location:string ->

     

       41
        
         ?description:string ->

     

       42
        
         ?recurrence:Icalendar.recurrence ->

     

       43
        
         t ->

     

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

     

       45
       +
       (** Edit an existing event. *)

     

       46
        
       

     

       47
       +
       val events_of_icalendar :

     

       48
       +
         string -> file:Eio.Fs.dir_ty Eio.Path.t -> Icalendar.calendar -> t list

     

       49
        
       

     

       50
       +
       val to_ical_event : t -> Icalendar.event

     

       51
       +
       val to_ical_calendar : t -> Icalendar.calendar

     

       0
        
       
     

       52
        
       val get_id : t -> event_id

     

       53
        
       val get_summary : t -> string option

     

       54
       +
       

     

       55
        
       val get_start : t -> Ptime.t

     

       56
       +
       (** Get the start time of an event. Note that local times are converted to UTC

     

       57
       +
           based on their timezone information. If no timezone is specified, the system

     

       58
       +
           timezone is used. *)

     

       59
       +
       

     

       60
        
       val get_end : t -> Ptime.t option

     

       61
       +
       (** Get the end time of an event. Like get_start, times are converted to UTC

     

       62
       +
           based on timezone information. Returns None if the event doesn't have an end

     

       63
       +
           time. *)

     

       64
       +
       

     

       65
       +
       val is_date : t -> bool

     

       66
       +
       (** Returns true if either the start or end timestamp is specified as a date

     

       67
       +
           instead of a datetime. *)

     

       68
       +
       

     

       69
       +
       val get_start_timezone : t -> string option

     

       70
       +
       val get_end_timezone : t -> string option

     

       71
        
       val get_duration : t -> Ptime.span option

     

       0
        
       
     

       72
        
       val get_location : t -> string option

     

       73
        
       val get_description : t -> string option

     

       74
        
       val get_recurrence : t -> Icalendar.recurrence option

     

       75
       +
       val get_calendar_name : t -> string

     

       76
       +
       val get_file : t -> Eio.Fs.dir_ty Eio.Path.t

     

       77
       +
       val expand_recurrences : from:Ptime.t option -> to_:Ptime.t -> t -> t list

     

       78
       +
       

     

       79
       +
       (** {2 Comparators} *)

     

       80
        
       

     

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

     

       82
       +
       (** Event comparator function type *)

     

       83
       +
       

     

       84
       +
       val by_start : comparator

     

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

     

       86
       +
       

     

       87
       +
       val by_end : comparator

     

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

     

       89
       +
           come after those without *)

     

       90
       +
       

     

       91
       +
       val by_summary : comparator

     

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

     

       93
       +
           those without *)

     

       94
       +
       

     

       95
       +
       val by_location : comparator

     

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

     

       97
       +
           those without *)

     

       98
       +
       

     

       99
       +
       val by_calendar_name : comparator

     

       100
       +
       (** Compare events by calendar_name name alphabetically *)

     

       101
       +
       

     

       102
       +
       val descending : comparator -> comparator

     

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

     

       104
       +
       

     

       105
       +
       val chain : comparator -> comparator -> comparator

     

       106
       +
       (** Chain two comparators together, using the second one as a tiebreaker when

     

       107
       +
           the first one returns equality (0) *)

     

       108
       +
       

     

       109
       +
       (** 2 Formatting *)

     

       110
       +
       

     

       111
       +
       type format = [ `Text | `Entries | `Json | `Csv | `Ics | `Sexp ]

     

       112
       +
       (** Format type for output *)

     

       113
       +
       

     

       114
       +
       val format_event : ?format:format -> ?tz:Timedesc.Time_zone.t -> t -> string

     

       115
       +
       (** Format a single event, optionally using the specified timezone *)

     

       116
       +
       

     

       117
       +
       val format_events :

     

       118
       +
         ?format:format -> ?tz:Timedesc.Time_zone.t -> t list -> string

     

       119
       +
       (** Format a list of events, optionally using the specified timezone *)

     

       120
       +
       

     

       121
       +
       val sexp_of_t : t -> Sexplib0.Sexp.t

     

       122
       +
       

     

       123
       +
       (** 3 Queries *)

     

       124
       +
       

     

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

     

       126
       +
       

     

       127
       +
       type filter = t -> bool

     

       128
       +
       

     

       129
       +
       val summary_contains : string -> filter

     

       130
       +
       val description_contains : string -> filter

     

       131
       +
       val location_contains : string -> filter

     

       132
       +
       val in_calendars : string list -> filter

     

       133
       +
       val recurring_only : unit -> filter

     

       134
       +
       val non_recurring_only : unit -> filter

     

       135
       +
       val with_id : event_id -> filter

     

       136
       +
       val and_filter : filter list -> filter

     

       137
       +
       val or_filter : filter list -> filter

     

       138
       +
       val not_filter : filter -> filter

     

       139
       +
       

     

       140
       +
       val query_without_recurrence :

     

       141
       +
         t list ->

     

       142
       +
         ?filter:filter ->

     

       143
       +
         ?comparator:comparator ->

     

       144
       +
         ?limit:int ->

     

       145
       +
         unit ->

     

       146
       +
         t list

     

       147
       +
       (** Find events without expansion of recurring events. Returns Ok with the list

     

       148
       +
           of events, or Error with a message. *)

     

       149
       +
       

     

       150
       +
       val query :

     

       151
       +
         t list ->

     

       152
       +
         ?filter:filter ->

     

       153
       +
         from:Ptime.t option ->

     

       154
       +
         to_:Ptime.t ->

     

       155
       +
         ?comparator:comparator ->

     

       156
       +
         ?limit:int ->

     

       157
       +
         unit ->

     

       158
       +
         t list

     

       159
       +
       (** Find events with expansion of recurring events. Returns Ok with the list of

     

       160
       +
           events, or Error with a message. *)

     

       161
       +
       

     

       162
       +
       (* Test-only helper functions *)

     

       163
       +
       val matches_filter : t -> filter -> bool

     

       164
       +
       (** Check if an event matches the given filter *)

-349

lib/format.ml

···

       1
       -
       type format = [ `Text | `Json | `Csv | `Ics | `Entries | `Sexp ]

     

       2
       -
       

     

       3
       -
       let ptime_to_timedesc ptime =

     

       4
       -
         let ts = Timedesc.Utils.timestamp_of_ptime ptime in

     

       5
       -
         match Timedesc.of_timestamp ts with

     

       6
       -
         | Some dt -> dt

     

       7
       -
         | None -> failwith "Invalid date conversion from Ptime to Timedesc"

     

       8
       -
       

     

       9
       -
       let format_date date =

     

       10
       -
         let dt = ptime_to_timedesc date in

     

       11
       -
         let y = Timedesc.year dt in

     

       12
       -
         let m = Timedesc.month dt in

     

       13
       -
         let d = Timedesc.day dt in

     

       14
       -
         let weekday =

     

       15
       -
           match Timedesc.weekday dt with

     

       16
       -
           | `Mon -> "Mon"

     

       17
       -
           | `Tue -> "Tue"

     

       18
       -
           | `Wed -> "Wed"

     

       19
       -
           | `Thu -> "Thu"

     

       20
       -
           | `Fri -> "Fri"

     

       21
       -
           | `Sat -> "Sat"

     

       22
       -
           | `Sun -> "Sun"

     

       23
       -
         in

     

       24
       -
         Printf.sprintf "%04d-%02d-%02d %s" y m d weekday

     

       25
       -
       

     

       26
       -
       let format_time date =

     

       27
       -
         let _, ((h, m, _), _) = Ptime.to_date_time date in

     

       28
       -
         Printf.sprintf "%02d:%02d" h m

     

       29
       -
       

     

       30
       -
       let format_datetime date =

     

       31
       -
         Printf.sprintf "%s %s" (format_date date) (format_time date)

     

       32
       -
       

     

       33
       -
       let next_day day ~next =

     

       34
       -
         let y1, m1, d1 = Ptime.to_date day in

     

       35
       -
         let y2, m2, d2 = Ptime.to_date next in

     

       36
       -
         y1 == y2 && m1 == m2 && d1 == d2 - 1

     

       37
       -
       

     

       38
       -
       (* exosed from icalendar *)

     

       39
       -
       

     

       40
       -
       let weekday_strings =

     

       41
       -
         [

     

       42
       -
           (`Monday, "MO");

     

       43
       -
           (`Tuesday, "TU");

     

       44
       -
           (`Wednesday, "WE");

     

       45
       -
           (`Thursday, "TH");

     

       46
       -
           (`Friday, "FR");

     

       47
       -
           (`Saturday, "SA");

     

       48
       -
           (`Sunday, "SU");

     

       49
       -
         ]

     

       50
       -
       

     

       51
       -
       let freq_strings =

     

       52
       -
         [

     

       53
       -
           (`Daily, "DAILY");

     

       54
       -
           (`Hourly, "HOURLY");

     

       55
       -
           (`Minutely, "MINUTELY");

     

       56
       -
           (`Monthly, "MONTHLY");

     

       57
       -
           (`Secondly, "SECONDLY");

     

       58
       -
           (`Weekly, "WEEKLY");

     

       59
       -
           (`Yearly, "YEARLY");

     

       60
       -
         ]

     

       61
       -
       

     

       62
       -
       let date_to_str (y, m, d) = Printf.sprintf "%04d%02d%02d" y m d

     

       63
       -
       

     

       64
       -
       let datetime_to_str ptime utc =

     

       65
       -
         let date, ((hh, mm, ss), _) = Ptime.to_date_time ptime in

     

       66
       -
         Printf.sprintf "%sT%02d%02d%02d%s" (date_to_str date) hh mm ss

     

       67
       -
           (if utc then "Z" else "")

     

       68
       -
       

     

       69
       -
       let timestamp_to_ics ts buf =

     

       70
       -
         Buffer.add_string buf

     

       71
       -
         @@

     

       72
       -
         match ts with

     

       73
       -
         | `Utc ts -> datetime_to_str ts true

     

       74
       -
         | `Local ts -> datetime_to_str ts false

     

       75
       -
         | `With_tzid (ts, _str) -> (* TODO *) datetime_to_str ts false

     

       76
       -
       

     

       77
       -
       let recurs_to_ics (freq, count_or_until, interval, l) buf =

     

       78
       -
         let write_rulepart key value =

     

       79
       -
           Buffer.add_string buf key;

     

       80
       -
           Buffer.add_char buf '=';

     

       81
       -
           Buffer.add_string buf value

     

       82
       -
         in

     

       83
       -
         let int_list l = String.concat "," @@ List.map string_of_int l in

     

       84
       -
         let recur_to_ics = function

     

       85
       -
           | `Byminute byminlist -> write_rulepart "BYMINUTE" (int_list byminlist)

     

       86
       -
           | `Byday bywdaylist ->

     

       87
       -
               let wday (weeknumber, weekday) =

     

       88
       -
                 (if weeknumber = 0 then "" else string_of_int weeknumber)

     

       89
       -
                 ^ List.assoc weekday weekday_strings

     

       90
       -
               in

     

       91
       -
               write_rulepart "BYDAY" (String.concat "," @@ List.map wday bywdaylist)

     

       92
       -
           | `Byhour byhrlist -> write_rulepart "BYHOUR" (int_list byhrlist)

     

       93
       -
           | `Bymonth bymolist -> write_rulepart "BYMONTH" (int_list bymolist)

     

       94
       -
           | `Bymonthday bymodaylist ->

     

       95
       -
               write_rulepart "BYMONTHDAY" (int_list bymodaylist)

     

       96
       -
           | `Bysecond byseclist -> write_rulepart "BYSECOND" (int_list byseclist)

     

       97
       -
           | `Bysetposday bysplist -> write_rulepart "BYSETPOS" (int_list bysplist)

     

       98
       -
           | `Byweek bywknolist -> write_rulepart "BYWEEKNO" (int_list bywknolist)

     

       99
       -
           | `Byyearday byyrdaylist ->

     

       100
       -
               write_rulepart "BYYEARDAY" (int_list byyrdaylist)

     

       101
       -
           | `Weekday weekday ->

     

       102
       -
               write_rulepart "WKST" (List.assoc weekday weekday_strings)

     

       103
       -
         in

     

       104
       -
         write_rulepart "FREQ" (List.assoc freq freq_strings);

     

       105
       -
         (match count_or_until with

     

       106
       -
         | None -> ()

     

       107
       -
         | Some x -> (

     

       108
       -
             Buffer.add_char buf ';';

     

       109
       -
             match x with

     

       110
       -
             | `Count c -> write_rulepart "COUNT" (string_of_int c)

     

       111
       -
             | `Until enddate ->

     

       112
       -
                 (* TODO cleanup *)

     

       113
       -
                 Buffer.add_string buf "UNTIL=";

     

       114
       -
                 timestamp_to_ics enddate buf));

     

       115
       -
         (match interval with

     

       116
       -
         | None -> ()

     

       117
       -
         | Some i ->

     

       118
       -
             Buffer.add_char buf ';';

     

       119
       -
             write_rulepart "INTERVAL" (string_of_int i));

     

       120
       -
         List.iter

     

       121
       -
           (fun recur ->

     

       122
       -
             Buffer.add_char buf ';';

     

       123
       -
             recur_to_ics recur)

     

       124
       -
           l

     

       125
       -
       

     

       126
       -
       let format_alt ~format ~start ~end_ event =

     

       127
       -
         let open Event in

     

       128
       -
         match format with

     

       129
       -
         | `Text ->

     

       130
       -
             let id = get_id event in

     

       131
       -
             let start_date = " " ^ format_date start in

     

       132
       -
             let start_time =

     

       133
       -
               match get_day_event event with

     

       134
       -
               | true -> ""

     

       135
       -
               | false -> " " ^ format_time start

     

       136
       -
             in

     

       137
       -
             let end_date, end_time =

     

       138
       -
               match end_ with

     

       139
       -
               | None -> ("", "")

     

       140
       -
               | Some end_ -> (

     

       141
       -
                   match (get_day_event event, next_day start ~next:end_) with

     

       142
       -
                   | true, true -> ("", "")

     

       143
       -
                   | true, _ -> (" - " ^ format_date end_, "")

     

       144
       -
                   | false, true -> ("", " - " ^ format_time end_)

     

       145
       -
                   | false, _ -> (" - " ^ format_date end_, " " ^ format_time end_))

     

       146
       -
             in

     

       147
       -
             let summary =

     

       148
       -
               match get_summary event with

     

       149
       -
               | Some summary when summary <> "" -> " " ^ summary

     

       150
       -
               | _ -> ""

     

       151
       -
             in

     

       152
       -
             let location =

     

       153
       -
               match get_location event with

     

       154
       -
               | Some loc when loc <> "" -> " @" ^ loc

     

       155
       -
               | _ -> ""

     

       156
       -
             in

     

       157
       -
             Printf.sprintf "%-45s%s%s%s%s%s%s" id start_date start_time end_date

     

       158
       -
               end_time summary location

     

       159
       -
         | `Json ->

     

       160
       -
             let open Yojson.Safe in

     

       161
       -
             let json =

     

       162
       -
               `Assoc

     

       163
       -
                 [

     

       164
       -
                   ("id", `String (get_id event));

     

       165
       -
                   ( "summary",

     

       166
       -
                     match get_summary event with

     

       167
       -
                     | Some summary -> `String summary

     

       168
       -
                     | None -> `Null );

     

       169
       -
                   ("start", `String (format_datetime start));

     

       170
       -
                   ( "end",

     

       171
       -
                     match end_ with

     

       172
       -
                     | Some e -> `String (format_datetime e)

     

       173
       -
                     | None -> `Null );

     

       174
       -
                   ( "location",

     

       175
       -
                     match get_location event with

     

       176
       -
                     | Some loc -> `String loc

     

       177
       -
                     | None -> `Null );

     

       178
       -
                   ( "description",

     

       179
       -
                     match get_description event with

     

       180
       -
                     | Some desc -> `String desc

     

       181
       -
                     | None -> `Null );

     

       182
       -
                   ( "calendar",

     

       183
       -
                     match get_collection event with

     

       184
       -
                     | Collection.Col cal -> `String cal );

     

       185
       -
                 ]

     

       186
       -
             in

     

       187
       -
             to_string json

     

       188
       -
         | `Csv ->

     

       189
       -
             let summary =

     

       190
       -
               match get_summary event with Some summary -> summary | None -> ""

     

       191
       -
             in

     

       192
       -
             let start = format_datetime start in

     

       193
       -
             let end_str =

     

       194
       -
               match end_ with Some e -> format_datetime e | None -> ""

     

       195
       -
             in

     

       196
       -
             let location =

     

       197
       -
               match get_location event with Some loc -> loc | None -> ""

     

       198
       -
             in

     

       199
       -
             let cal_id =

     

       200
       -
               match get_collection event with Collection.Col cal -> cal

     

       201
       -
             in

     

       202
       -
             Printf.sprintf "\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" summary start end_str

     

       203
       -
               location cal_id

     

       204
       -
         | `Ics ->

     

       205
       -
             let cal_props = [] in

     

       206
       -
             let event_ical = Event.to_icalendar event in

     

       207
       -
             Icalendar.to_ics ~cr:true (cal_props, [ `Event event_ical ])

     

       208
       -
         | `Entries ->

     

       209
       -
             let summary =

     

       210
       -
               match get_summary event with Some summary -> summary | None -> ""

     

       211
       -
             in

     

       212
       -
             let start = format_datetime start in

     

       213
       -
             let end_str =

     

       214
       -
               match end_ with Some e -> format_datetime e | None -> ""

     

       215
       -
             in

     

       216
       -
             let location =

     

       217
       -
               match get_location event with Some loc -> loc | None -> ""

     

       218
       -
             in

     

       219
       -
             let description =

     

       220
       -
               match get_description event with Some desc -> desc | None -> ""

     

       221
       -
             in

     

       222
       -
             let rrule =

     

       223
       -
               match get_recurrence event with

     

       224
       -
               | Some r ->

     

       225
       -
                   let buf = Buffer.create 128 in

     

       226
       -
                   recurs_to_ics r buf;

     

       227
       -
                   Buffer.contents buf

     

       228
       -
               | None -> ""

     

       229
       -
             in

     

       230
       -
             Printf.sprintf "%s: %s\n%s: %s\n%s: %s\n%s: %s\n%s: %s\n%s: %s" "Summary"

     

       231
       -
               summary "Start" start "End" end_str "Location" location "Description"

     

       232
       -
               description "Reccurence" rrule

     

       233
       -
         | `Sexp ->

     

       234
       -
             let summary =

     

       235
       -
               match get_summary event with Some summary -> summary | None -> ""

     

       236
       -
             in

     

       237
       -
             let start_date, start_time =

     

       238
       -
               let dt = ptime_to_timedesc start in

     

       239
       -
               let y = Timedesc.year dt in

     

       240
       -
               let m = Timedesc.month dt in

     

       241
       -
               let d = Timedesc.day dt in

     

       242
       -
               let h = Timedesc.hour dt in

     

       243
       -
               let min = Timedesc.minute dt in

     

       244
       -
               let s = Timedesc.second dt in

     

       245
       -
               let dow =

     

       246
       -
                 match Timedesc.weekday dt with

     

       247
       -
                 | `Mon -> "monday"

     

       248
       -
                 | `Tue -> "tuesday"

     

       249
       -
                 | `Wed -> "wednesday"

     

       250
       -
                 | `Thu -> "thursday"

     

       251
       -
                 | `Fri -> "friday"

     

       252
       -
                 | `Sat -> "saturday"

     

       253
       -
                 | `Sun -> "sunday"

     

       254
       -
               in

     

       255
       -
               ( Printf.sprintf "(%04d %02d %02d %s)" y m d dow,

     

       256
       -
                 Printf.sprintf "(%02d %02d %02d)" h min s )

     

       257
       -
             in

     

       258
       -
             let end_str =

     

       259
       -
               match end_ with

     

       260
       -
               | Some end_date ->

     

       261
       -
                   let dt = ptime_to_timedesc end_date in

     

       262
       -
                   let y = Timedesc.year dt in

     

       263
       -
                   let m = Timedesc.month dt in

     

       264
       -
                   let d = Timedesc.day dt in

     

       265
       -
                   let h = Timedesc.hour dt in

     

       266
       -
                   let min = Timedesc.minute dt in

     

       267
       -
                   let s = Timedesc.second dt in

     

       268
       -
                   let dow =

     

       269
       -
                     match Timedesc.weekday dt with

     

       270
       -
                     | `Mon -> "monday"

     

       271
       -
                     | `Tue -> "tuesday"

     

       272
       -
                     | `Wed -> "wednesday"

     

       273
       -
                     | `Thu -> "thursday"

     

       274
       -
                     | `Fri -> "friday"

     

       275
       -
                     | `Sat -> "saturday"

     

       276
       -
                     | `Sun -> "sunday"

     

       277
       -
                   in

     

       278
       -
                   Printf.sprintf "((%04d %02d %02d %s) (%02d %02d %02d))" y m d dow h

     

       279
       -
                     min s

     

       280
       -
               | None -> "nil"

     

       281
       -
             in

     

       282
       -
             let location =

     

       283
       -
               match get_location event with

     

       284
       -
               | Some loc -> Printf.sprintf "\"%s\"" (String.escaped loc)

     

       285
       -
               | None -> "nil"

     

       286
       -
             in

     

       287
       -
             let description =

     

       288
       -
               match get_description event with

     

       289
       -
               | Some desc -> Printf.sprintf "\"%s\"" (String.escaped desc)

     

       290
       -
               | None -> "nil"

     

       291
       -
             in

     

       292
       -
             let calendar =

     

       293
       -
               match get_collection event with

     

       294
       -
               | Collection.Col cal -> Printf.sprintf "\"%s\"" (String.escaped cal)

     

       295
       -
             in

     

       296
       -
             let id = get_id event in

     

       297
       -
             Printf.sprintf

     

       298
       -
               "((:id \"%s\" :summary \"%s\" :start (%s %s) :end %s :location %s \

     

       299
       -
                :description %s :calendar %s))"

     

       300
       -
               (String.escaped id) (String.escaped summary) start_date start_time

     

       301
       -
               end_str location description calendar

     

       302
       -
       

     

       303
       -
       let format_event ?(format = `Text) event =

     

       304
       -
         format_alt ~format ~start:(Event.get_start event) ~end_:(Event.get_end event)

     

       305
       -
           event

     

       306
       -
       

     

       307
       -
       let format_instance ?(format = `Text) instance =

     

       308
       -
         let open Recur in

     

       309
       -
         format_alt ~format ~start:instance.start ~end_:instance.end_ instance.event

     

       310
       -
       

     

       311
       -
       let format_events ?(format = `Text) events =

     

       312
       -
         match format with

     

       313
       -
         | `Json ->

     

       314
       -
             let json_events =

     

       315
       -
               List.map

     

       316
       -
                 (fun e -> Yojson.Safe.from_string (format_event ~format:`Json e))

     

       317
       -
                 events

     

       318
       -
             in

     

       319
       -
             Yojson.Safe.to_string (`List json_events)

     

       320
       -
         | `Csv ->

     

       321
       -
             "\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"

     

       322
       -
             ^ String.concat "\n" (List.map (format_event ~format:`Csv) events)

     

       323
       -
         | `Sexp ->

     

       324
       -
             "("

     

       325
       -
             ^ String.concat "\n "

     

       326
       -
                 (List.map (fun e -> format_event ~format:`Sexp e) events)

     

       327
       -
             ^ ")"

     

       328
       -
         | _ -> String.concat "\n" (List.map (fun e -> format_event ~format e) events)

     

       329
       -
       

     

       330
       -
       let format_instances ?(format = `Text) instances =

     

       331
       -
         match format with

     

       332
       -
         | `Json ->

     

       333
       -
             let json_instances =

     

       334
       -
               List.map

     

       335
       -
                 (fun e -> Yojson.Safe.from_string (format_instance ~format:`Json e))

     

       336
       -
                 instances

     

       337
       -
             in

     

       338
       -
             Yojson.Safe.to_string (`List json_instances)

     

       339
       -
         | `Csv ->

     

       340
       -
             "\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"

     

       341
       -
             ^ String.concat "\n" (List.map (format_instance ~format:`Csv) instances)

     

       342
       -
         | `Sexp ->

     

       343
       -
             "("

     

       344
       -
             ^ String.concat "\n "

     

       345
       -
                 (List.map (fun e -> format_instance ~format:`Sexp e) instances)

     

       346
       -
             ^ ")"

     

       347
       -
         | _ ->

     

       348
       -
             String.concat "\n"

     

       349
       -
               (List.map (fun e -> format_instance ~format e) instances)

-17

lib/format.mli

···

       1
       -
       (** Functions for formatting various data structures as strings *)

     

       2
       -
       

     

       3
       -
       type format = [ `Text | `Json | `Csv | `Ics | `Entries | `Sexp ]

     

       4
       -
       (** Format type for output *)

     

       5
       -
       

     

       6
       -
       (** Functions for formatting specific event types *)

     

       7
       -
       val format_event : ?format:format -> Event.t -> string

     

       8
       -
       (** Format a single event *)

     

       9
       -
       

     

       10
       -
       val format_instance : ?format:format -> Recur.instance -> string

     

       11
       -
       (** Format a single event instance *)

     

       12
       -
       

     

       13
       -
       val format_events : ?format:format -> Event.t list -> string

     

       14
       -
       (** Format a list of events *)

     

       15
       -
       

     

       16
       -
       val format_instances : ?format:format -> Recur.instance list -> string

     

       17
       -
       (** Format a list of event instances *)

-162

lib/query.ml

···

       1
       -
       type 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
       -
       

     

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

     

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

     

       15
       -
       

     

       16
       -
       let summary_contains text = SummaryContains text

     

       17
       -
       let description_contains text = DescriptionContains text

     

       18
       -
       let location_contains text = LocationContains text

     

       19
       -
       let in_collections ids = InCollections ids

     

       20
       -
       let recurring_only () = RecurringOnly

     

       21
       -
       let non_recurring_only () = NonRecurringOnly

     

       22
       -
       let with_id id = WithId id

     

       23
       -
       let and_filter filters = And filters

     

       24
       -
       let or_filter filters = Or filters

     

       25
       -
       let not_filter filter = Not filter

     

       26
       -
       

     

       27
       -
       let 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
       -
       

     

       56
       -
       let 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
       -
       

     

       87
       -
       let 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
       -
       

     

       118
       -
       let 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

-54

lib/query.mli

···

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

     

       2
       -
       

     

       3
       -
       type filter

     

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

     

       5
       -
       

     

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

     

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

     

       8
       -
       

     

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

     

       10
       -
       (** Type representing sort criteria *)

     

       11
       -
       

     

       12
       -
       val summary_contains : string -> filter

     

       13
       -
       val description_contains : string -> filter

     

       14
       -
       val location_contains : string -> filter

     

       15
       -
       val in_collections : Collection.t list -> filter

     

       16
       -
       val recurring_only : unit -> filter

     

       17
       -
       val non_recurring_only : unit -> filter

     

       18
       -
       val with_id : Event.event_id -> filter

     

       19
       -
       val and_filter : filter list -> filter

     

       20
       -
       val or_filter : filter list -> filter

     

       21
       -
       val not_filter : filter -> filter

     

       22
       -
       

     

       23
       -
       val query_events :

     

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

     

       25
       -
         Calendar_dir.t ->

     

       26
       -
         ?filter:filter ->

     

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

     

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

     

       29
       -
         ?limit:int ->

     

       30
       -
         unit ->

     

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

     

       32
       -
       (** Find events without expansion of recurring events. Returns Ok with the list

     

       33
       -
           of events, or Error with a message. *)

     

       34
       -
       

     

       35
       -
       val query :

     

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

     

       37
       -
         Calendar_dir.t ->

     

       38
       -
         ?filter:filter ->

     

       39
       -
         from:Ptime.t option ->

     

       40
       -
         to_:Ptime.t ->

     

       41
       -
         ?sort_by:sort_by ->

     

       42
       -
         ?order:sort_order ->

     

       43
       -
         ?limit:int ->

     

       44
       -
         unit ->

     

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

     

       46
       -
       (** Find events with expansion of recurring events. Returns Ok with the list of

     

       47
       -
           instances, or Error with a message. *)

     

       48
       -
       

     

       49
       -
       (* Test-only helper functions *)

     

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

     

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

     

       52
       -
       

     

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

     

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

-177

lib/recur.ml

···

       1
       -
       open Icalendar

     

       2
       -
       

     

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

     

       4
       -
       

     

       5
       -
       let clone_with_time original start =

     

       6
       -
         let duration = Event.get_duration original in

     

       7
       -
         let end_ =

     

       8
       -
           match duration with Some span -> Ptime.add_span start span | None -> None

     

       9
       -
         in

     

       10
       -
         { event = original; start; end_ }

     

       11
       -
       

     

       12
       -
       let expand_event event ~from ~to_ =

     

       13
       -
         let rule = Event.get_recurrence event in

     

       14
       -
         match rule with

     

       15
       -
         (* If there's no recurrence we just return the original event. *)

     

       16
       -
         | None ->

     

       17
       -
             (* Include the original event instance only if it falls within the query range *)

     

       18
       -
             let start = Event.get_start event in

     

       19
       -
             let end_ = match Event.get_end event with None -> start | Some e -> e in

     

       20
       -
             if

     

       21
       -
               Ptime.is_earlier start ~than:to_

     

       22
       -
               &&

     

       23
       -
               match from with Some f -> Ptime.is_later end_ ~than:f | None -> true

     

       24
       -
             then [ clone_with_time event start ]

     

       25
       -
             else []

     

       26
       -
         (* We return all instances within the range, regardless of whether the original

     

       27
       -
            event instance was included. This ensures recurring events that start before

     

       28
       -
            the query range but have instances within it are properly included. *)

     

       29
       -
         | Some rule ->

     

       30
       -
             let rec collect generator acc =

     

       31
       -
               match generator () with

     

       32
       -
               | None -> List.rev acc

     

       33
       -
               | Some date ->

     

       34
       -
                   if Ptime.compare date to_ > 0 then List.rev acc

     

       35
       -
                   else if

     

       36
       -
                     match from with

     

       37
       -
                     | Some f -> Ptime.compare date f < 0

     

       38
       -
                     | None -> false

     

       39
       -
                   then collect generator acc

     

       40
       -
                   else collect generator (clone_with_time event date :: acc)

     

       41
       -
             in

     

       42
       -
             let start_date = Event.get_start event in

     

       43
       -
             let generator = recur_dates start_date rule in

     

       44
       -
             collect generator []

     

       45
       -
       

     

       46
       -
       let combine_results (results : ('a, 'b) result list) : ('a list, 'b) result =

     

       47
       -
         let rec aux acc = function

     

       48
       -
           | [] -> Ok (List.rev acc)

     

       49
       -
           | Ok v :: rest -> aux (v :: acc) rest

     

       50
       -
           | Error e :: _ -> Error e

     

       51
       -
         in

     

       52
       -
         aux [] results

     

       53
       -
       

     

       54
       -
       let parse_recurrence recur =

     

       55
       -
         let ( let* ) = Result.bind in

     

       56
       -
         let parts = String.split_on_char ';' recur in

     

       57
       -
         let freq = ref None in

     

       58
       -
         let count = ref None in

     

       59
       -
         let until = ref None in

     

       60
       -
         let interval = ref None in

     

       61
       -
         let by_parts = ref [] in

     

       62
       -
         let results =

     

       63
       -
           List.map

     

       64
       -
             (fun part ->

     

       65
       -
               let kv = String.split_on_char '=' part in

     

       66
       -
               match kv with

     

       67
       -
               | [ "FREQ"; value ] -> (

     

       68
       -
                   match String.uppercase_ascii value with

     

       69
       -
                   | "DAILY" ->

     

       70
       -
                       freq := Some `Daily;

     

       71
       -
                       Ok ()

     

       72
       -
                   | "WEEKLY" ->

     

       73
       -
                       freq := Some `Weekly;

     

       74
       -
                       Ok ()

     

       75
       -
                   | "MONTHLY" ->

     

       76
       -
                       freq := Some `Monthly;

     

       77
       -
                       Ok ()

     

       78
       -
                   | "YEARLY" ->

     

       79
       -
                       freq := Some `Yearly;

     

       80
       -
                       Ok ()

     

       81
       -
                   | _ -> Error (`Msg ("Unsupported frequency: " ^ value)))

     

       82
       -
               | [ "COUNT"; value ] ->

     

       83
       -
                   if !until <> None then

     

       84
       -
                     Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")

     

       85
       -
                   else (

     

       86
       -
                     count := Some (`Count (int_of_string value));

     

       87
       -
                     Ok ())

     

       88
       -
               | [ "UNTIL"; value ] -> (

     

       89
       -
                   if !count <> None then

     

       90
       -
                     Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")

     

       91
       -
                   else

     

       92
       -
                     let* v =

     

       93
       -
                       match parse_datetime value with

     

       94
       -
                       | Ok v -> Ok v

     

       95
       -
                       | Error e -> Error (`Msg e)

     

       96
       -
                     in

     

       97
       -
                     match v with

     

       98
       -
                     | `With_tzid _ -> Error (`Msg "Until can't be in a timezone")

     

       99
       -
                     | `Utc u ->

     

       100
       -
                         until := Some (`Until (`Utc u));

     

       101
       -
                         Ok ()

     

       102
       -
                     | `Local l ->

     

       103
       -
                         until := Some (`Until (`Local l));

     

       104
       -
                         Ok ())

     

       105
       -
               | [ "INTERVAL"; value ] ->

     

       106
       -
                   interval := Some (int_of_string value);

     

       107
       -
                   Ok ()

     

       108
       -
               | [ "BYDAY"; value ] ->

     

       109
       -
                   (* Parse day specifications like MO,WE,FR or 1MO,-1FR *)

     

       110
       -
                   let days = String.split_on_char ',' value in

     

       111
       -
                   let parse_day day =

     

       112
       -
                     (* Extract ordinal if present (like 1MO or -1FR) *)

     

       113
       -
                     let ordinal, day_code =

     

       114
       -
                       if

     

       115
       -
                         String.length day >= 3

     

       116
       -
                         && (String.get day 0 = '+'

     

       117
       -
                            || String.get day 0 = '-'

     

       118
       -
                            || (String.get day 0 >= '0' && String.get day 0 <= '9'))

     

       119
       -
                       then (

     

       120
       -
                         let idx = ref 0 in

     

       121
       -
                         while

     

       122
       -
                           !idx < String.length day

     

       123
       -
                           && (String.get day !idx = '+'

     

       124
       -
                              || String.get day !idx = '-'

     

       125
       -
                              || String.get day !idx >= '0'

     

       126
       -
                                 && String.get day !idx <= '9')

     

       127
       -
                         do

     

       128
       -
                           incr idx

     

       129
       -
                         done;

     

       130
       -
                         let ord_str = String.sub day 0 !idx in

     

       131
       -
                         let day_str =

     

       132
       -
                           String.sub day !idx (String.length day - !idx)

     

       133
       -
                         in

     

       134
       -
                         (int_of_string ord_str, day_str))

     

       135
       -
                       else (0, day)

     

       136
       -
                     in

     

       137
       -
                     let* weekday =

     

       138
       -
                       match day_code with

     

       139
       -
                       | "MO" -> Ok `Monday

     

       140
       -
                       | "TU" -> Ok `Tuesday

     

       141
       -
                       | "WE" -> Ok `Wednesday

     

       142
       -
                       | "TH" -> Ok `Thursday

     

       143
       -
                       | "FR" -> Ok `Friday

     

       144
       -
                       | "SA" -> Ok `Saturday

     

       145
       -
                       | "SU" -> Ok `Sunday

     

       146
       -
                       | _ -> Error (`Msg ("Invalid weekday: " ^ day_code))

     

       147
       -
                     in

     

       148
       -
                     Ok (ordinal, weekday)

     

       149
       -
                   in

     

       150
       -
                   let* day_specs = combine_results (List.map parse_day days) in

     

       151
       -
                   by_parts := `Byday day_specs :: !by_parts;

     

       152
       -
                   Ok ()

     

       153
       -
               | [ "BYMONTHDAY"; value ] ->

     

       154
       -
                   let days = String.split_on_char ',' value in

     

       155
       -
                   let month_days = List.map int_of_string days in

     

       156
       -
                   by_parts := `Bymonthday month_days :: !by_parts;

     

       157
       -
                   Ok ()

     

       158
       -
               | [ "BYMONTH"; value ] ->

     

       159
       -
                   let months = String.split_on_char ',' value in

     

       160
       -
                   let month_nums = List.map int_of_string months in

     

       161
       -
                   by_parts := `Bymonth month_nums :: !by_parts;

     

       162
       -
                   Ok ()

     

       163
       -
               | _ -> Ok ())

     

       164
       -
             parts

     

       165
       -
         in

     

       166
       -
         let* _ = combine_results results in

     

       167
       -
         match !freq with

     

       168
       -
         | Some f ->

     

       169
       -
             let limit =

     

       170
       -
               match (!count, !until) with

     

       171
       -
               | Some c, None -> Some c

     

       172
       -
               | None, Some u -> Some u

     

       173
       -
               | _ -> None

     

       174
       -
             in

     

       175
       -
             let recurrence = (f, limit, !interval, !by_parts) in

     

       176
       -
             Ok recurrence

     

       177
       -
         | None -> Error (`Msg "FREQ is required in recurrence rule")

-11

lib/recur.mli

···

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

     

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

     

       3
       -
       

     

       4
       -
       val expand_event :

     

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

     

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

     

       7
       -
           original and recurrences. If the event result is an Error, returns an empty

     

       8
       -
           list. *)

     

       9
       -
       

     

       10
       -
       val parse_recurrence :

     

       11
       -
         string -> (Icalendar.recurrence, [ `Msg of string ]) result

+120

lib/sexp.ml

···

       1
       +
       open Sexplib.Std

     

       2
       +
       

     

       3
       +
       type search_field = Summary | Description | Location [@@deriving sexp]

     

       4
       +
       

     

       5
       +
       type query_request = {

     

       6
       +
         from : string option; [@sexp.option]

     

       7
       +
         to_ : string; (* Required field, not optional *)

     

       8
       +
         timezone : string option; [@sexp.option]

     

       9
       +
         calendars : string list; [@default []]

     

       10
       +
         text : string option; [@sexp.option]

     

       11
       +
         search_in : search_field list; [@default []]

     

       12
       +
         id : string option; [@sexp.option]

     

       13
       +
         recurring : bool option; [@sexp.option]

     

       14
       +
         limit : int option; [@sexp.option]

     

       15
       +
       }

     

       16
       +
       [@@deriving sexp]

     

       17
       +
       

     

       18
       +
       (* workaround https://github.com/janestreet/ppx_sexp_conv/issues/18#issuecomment-2792574295 *)

     

       19
       +
       let query_request_of_sexp sexp =

     

       20
       +
         let open Sexplib.Sexp in

     

       21
       +
         let sexp = match sexp with

     

       22
       +
           | List ss ->

     

       23
       +
             List (List.map (function List (Atom "to" :: v) -> List (Atom "to_" :: v) | v -> v) ss)

     

       24
       +
           | v -> v

     

       25
       +
         in

     

       26
       +
         query_request_of_sexp sexp

     

       27
       +
       

     

       28
       +
       let sexp_of_query_request q =

     

       29
       +
         let open Sexplib.Sexp in

     

       30
       +
         let sexp = sexp_of_query_request q in

     

       31
       +
         let sexp = match sexp with

     

       32
       +
           | List ss ->

     

       33
       +
             List (List.map (function List (Atom "to_" :: v) -> List (Atom "to" :: v) | v -> v) ss)

     

       34
       +
           | v -> v

     

       35
       +
         in

     

       36
       +
         sexp

     

       37
       +
       

     

       38
       +
       type request = ListCalendars | Query of query_request | Refresh [@@deriving sexp]

     

       39
       +
       

     

       40
       +
       type response_payload = Calendars of string list | Events of Event.t list | Empty

     

       41
       +
       [@@deriving sexp_of]

     

       42
       +
       

     

       43
       +
       type response = Ok of response_payload | Error of string [@@deriving sexp_of]

     

       44
       +
       

     

       45
       +
       let filter_func_of_search_field text = function

     

       46
       +
         | Summary -> Event.summary_contains text

     

       47
       +
         | Description -> Event.description_contains text

     

       48
       +
         | Location -> Event.location_contains text

     

       49
       +
       

     

       50
       +
       let parse_timezone ~timezone =

     

       51
       +
         match timezone with

     

       52
       +
         | Some tzid -> (

     

       53
       +
             match Timedesc.Time_zone.make tzid with

     

       54
       +
             | Some tz -> tz

     

       55
       +
             | None -> failwith ("Invalid timezone: " ^ tzid))

     

       56
       +
         | None -> !Date.default_timezone ()

     

       57
       +
       

     

       58
       +
       let generate_query_params (req : query_request) =

     

       59
       +
         let ( let* ) = Result.bind in

     

       60
       +
         let tz = parse_timezone ~timezone:req.timezone in

     

       61
       +
         let* from =

     

       62
       +
           match req.from with

     

       63
       +
           | None -> Ok None

     

       64
       +
           | Some s -> Result.map Option.some (Date.parse_date ~tz s `From)

     

       65
       +
         in

     

       66
       +
         let* to_ =

     

       67
       +
           let* to_date = Date.parse_date ~tz req.to_ `To in

     

       68
       +
           Ok (Date.to_end_of_day to_date)

     

       69
       +
         in

     

       70
       +
         let filters = ref [] in

     

       71
       +
         (match req.calendars with

     

       72
       +
         | [] -> ()

     

       73
       +
         | cals -> filters := Event.in_calendars cals :: !filters);

     

       74
       +
         (match req.text with

     

       75
       +
         | Some text ->

     

       76
       +
             let search_fields =

     

       77
       +
               match req.search_in with

     

       78
       +
               | [] -> [ Summary; Description; Location ]

     

       79
       +
               | fields -> fields

     

       80
       +
             in

     

       81
       +
             let text_filters =

     

       82
       +
               List.map (filter_func_of_search_field text) search_fields

     

       83
       +
             in

     

       84
       +
             filters := Event.or_filter text_filters :: !filters

     

       85
       +
         | None -> ());

     

       86
       +
         (match req.id with

     

       87
       +
         | Some id -> filters := Event.with_id id :: !filters

     

       88
       +
         | None -> ());

     

       89
       +
         (match req.recurring with

     

       90
       +
         | Some true -> filters := Event.recurring_only () :: !filters

     

       91
       +
         | Some false -> filters := Event.non_recurring_only () :: !filters

     

       92
       +
         | _ -> ());

     

       93
       +
         let final_filter = Event.and_filter !filters in

     

       94
       +
         let limit = req.limit in

     

       95
       +
         Ok (final_filter, from, to_, limit, tz)

     

       96
       +
       

     

       97
       +
       let is_whitespace = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false

     

       98
       +
       

     

       99
       +
       let needs_quotes s =

     

       100
       +
         String.exists

     

       101
       +
           (fun c -> is_whitespace c || c = '(' || c = ')' || c = '"' || c = '\'')

     

       102
       +
           s

     

       103
       +
       

     

       104
       +
       let escape s =

     

       105
       +
         let buf = Buffer.create (String.length s) in

     

       106
       +
         String.iter

     

       107
       +
           (function

     

       108
       +
             | '"' -> Buffer.add_string buf "\\\""

     

       109
       +
             | '\\' -> Buffer.add_string buf "\\\\"

     

       110
       +
             | '\n' -> Buffer.add_string buf "\\n"

     

       111
       +
             | '\r' -> Buffer.add_string buf "\\r"

     

       112
       +
             | '\t' -> Buffer.add_string buf "\\t"

     

       113
       +
             | c -> Buffer.add_char buf c)

     

       114
       +
           s;

     

       115
       +
         "\"" ^ Buffer.contents buf ^ "\""

     

       116
       +
       

     

       117
       +
       let rec to_string = function

     

       118
       +
         | Sexplib.Sexp.Atom str -> if needs_quotes str then escape str else str

     

       119
       +
         | Sexplib.Sexp.List lst ->

     

       120
       +
             "(" ^ String.concat " " (List.map to_string lst) ^ ")"

+1 -1

test/dune

···

       1
        
       (tests

     

       2
       -
        (names test_calendar_dir test_query test_recur)

     

       3
        
        (libraries caledonia_lib alcotest str ptime)

     

       4
        
        (deps

     

       5
        
         (source_tree calendar)))

···

       1
        
       (tests

     

       2
       +
        (names test_calendar_dir test_date test_event)

     

       3
        
        (libraries caledonia_lib alcotest str ptime)

     

       4
        
        (deps

     

       5
        
         (source_tree calendar)))

+22 -34

test/test_calendar_dir.ml

···

       4
        
       

     

       5
        
       let calendar_dir_path = Filename.concat (Sys.getcwd ()) "calendar"

     

       6
        
       

     

       7
       -
       let test_list_collections ~fs () =

     

       8
        
         let calendar_dir =

     

       9
        
           match Calendar_dir.create ~fs calendar_dir_path with

     

       10
        
           | Ok dir -> dir

     

       11
        
           | Error (`Msg msg) ->

     

       12
        
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       13
        
         in

     

       14
       -
         match Calendar_dir.list_collections ~fs calendar_dir with

     

       15
       -
         | Error (`Msg msg) -> Alcotest.fail ("List collections failed: " ^ msg)

     

       16
       -
         | Ok collections ->

     

       17
        
             Alcotest.(check int)

     

       18
       -
               "Should find two collections" 2 (List.length collections);

     

       0
        
       
     

       19
        
             Alcotest.(check bool)

     

       20
        
               "example should be in the list" true

     

       21
       -
               (List.exists (fun c -> c = Collection.Col "example") collections);

     

       22
        
             Alcotest.(check bool)

     

       23
        
               "recurrence should be in the list" true

     

       24
       -
               (List.exists (fun c -> c = Collection.Col "recurrence") collections);

     

       25
        
             ()

     

       26
        
       

     

       27
       -
       let test_get_collection ~fs () =

     

       28
        
         let calendar_dir =

     

       29
        
           match Calendar_dir.create ~fs calendar_dir_path with

     

       30
        
           | Ok dir -> dir

     

       31
        
           | Error (`Msg msg) ->

     

       32
        
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       33
        
         in

     

       34
       -
         let result =

     

       35
       -
           Calendar_dir.get_collection ~fs calendar_dir (Collection.Col "example")

     

       36
       -
         in

     

       37
        
         match result with

     

       38
       -
         | Ok _ -> Alcotest.(check pass) "Should find example collection" () ()

     

       39
       -
         | Error `Not_found -> Alcotest.fail "Failed to find example collection"

     

       40
       -
         | Error (`Msg msg) -> Alcotest.fail ("Error getting collection: " ^ msg)

     

       41
        
       

     

       42
       -
       let test_get_collections ~fs () =

     

       43
        
         let calendar_dir =

     

       44
        
           match Calendar_dir.create ~fs calendar_dir_path with

     

       45
        
           | Ok dir -> dir

     

       46
        
           | Error (`Msg msg) ->

     

       47
        
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       48
        
         in

     

       49
       -
         match Calendar_dir.get_collections ~fs calendar_dir with

     

       50
       -
         | Ok collections ->

     

       51
       -
             Alcotest.(check int)

     

       52
       -
               "Should find two collections" 2 (List.length collections);

     

       53
       -
             Alcotest.(check bool)

     

       54
       -
               "example should be in the results" true

     

       55
       -
               (List.exists (fun (id, _) -> id = Collection.Col "example") collections);

     

       56
       -
             Alcotest.(check bool)

     

       57
       -
               "recurrence should be in the results" true

     

       58
       -
               (List.exists

     

       59
       -
                  (fun (id, _) -> id = Collection.Col "recurrence")

     

       60
       -
                  collections);

     

       61
        
             ()

     

       62
        
         | Error e ->

     

       63
       -
             let msg =

     

       64
       -
               match e with `Msg m -> m | `Not_found -> "Collection not found"

     

       65
       -
             in

     

       66
       -
             Alcotest.fail ("Error getting collections: " ^ msg)

     

       67
        
       

     

       68
        
       let calendar_tests fs =

     

       69
        
         [

     

       70
       -
           ("list collections", `Quick, test_list_collections ~fs);

     

       71
       -
           ("get collection", `Quick, test_get_collection ~fs);

     

       72
       -
           ("get all collections", `Quick, test_get_collections ~fs);

     

       73
        
         ]

     

       74
        
       

     

       75
        
       let () =

···

       4
        
       

     

       5
        
       let calendar_dir_path = Filename.concat (Sys.getcwd ()) "calendar"

     

       6
        
       

     

       7
       +
       let test_list_calendar_names ~fs () =

     

       8
        
         let calendar_dir =

     

       9
        
           match Calendar_dir.create ~fs calendar_dir_path with

     

       10
        
           | Ok dir -> dir

     

       11
        
           | Error (`Msg msg) ->

     

       12
        
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       13
        
         in

     

       14
       +
         match Calendar_dir.list_calendar_names ~fs calendar_dir with

     

       15
       +
         | Error (`Msg msg) -> Alcotest.fail ("List calendar_names failed: " ^ msg)

     

       16
       +
         | Ok calendar_names ->

     

       17
        
             Alcotest.(check int)

     

       18
       +
               "Should find two calendar_names" 2

     

       19
       +
               (List.length calendar_names);

     

       20
        
             Alcotest.(check bool)

     

       21
        
               "example should be in the list" true

     

       22
       +
               (List.exists (fun c -> c = "example") calendar_names);

     

       23
        
             Alcotest.(check bool)

     

       24
        
               "recurrence should be in the list" true

     

       25
       +
               (List.exists (fun c -> c = "recurrence") calendar_names);

     

       26
        
             ()

     

       27
        
       

     

       28
       +
       let test_get_calendar_events ~fs () =

     

       29
        
         let calendar_dir =

     

       30
        
           match Calendar_dir.create ~fs calendar_dir_path with

     

       31
        
           | Ok dir -> dir

     

       32
        
           | Error (`Msg msg) ->

     

       33
        
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       34
        
         in

     

       35
       +
         let result = Calendar_dir.get_calendar_events ~fs calendar_dir "example" in

     

       0
        
       
     

       0
        
       
     

       36
        
         match result with

     

       37
       +
         | Ok _ -> Alcotest.(check pass) "Should find example calendar_name" () ()

     

       38
       +
         | Error `Not_found -> Alcotest.fail "Failed to find example calendar_name"

     

       39
       +
         | Error (`Msg msg) -> Alcotest.fail ("Error getting calendar_name: " ^ msg)

     

       40
        
       

     

       41
       +
       let test_get_events ~fs () =

     

       42
        
         let calendar_dir =

     

       43
        
           match Calendar_dir.create ~fs calendar_dir_path with

     

       44
        
           | Ok dir -> dir

     

       45
        
           | Error (`Msg msg) ->

     

       46
        
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       47
        
         in

     

       48
       +
         match Calendar_dir.get_events ~fs calendar_dir with

     

       49
       +
         | Ok events ->

     

       50
       +
             Alcotest.(check int) "Should find two events" 32 (List.length events);

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       51
        
             ()

     

       52
        
         | Error e ->

     

       53
       +
             let msg = match e with `Msg m -> m in

     

       54
       +
             Alcotest.fail ("Error getting calendar_names: " ^ msg)

     

       0
        
       
     

       0
        
       
     

       55
        
       

     

       56
        
       let calendar_tests fs =

     

       57
        
         [

     

       58
       +
           ("list calendar_names", `Quick, test_list_calendar_names ~fs);

     

       59
       +
           ("get calendar_name", `Quick, test_get_calendar_events ~fs);

     

       60
       +
           ("get all calendar_names", `Quick, test_get_events ~fs);

     

       61
        
         ]

     

       62
        
       

     

       63
        
       let () =

+13 -7

test/test_date.ml

···

       1
        
       (* Test the Date module *)

     

       2
        
       

     

       0
        
       
     

       0
        
       
     

       3
        
       (* Setup a fixed date for testing *)

     

       4
        
       let fixed_date = Option.get @@ Ptime.of_date_time ((2025, 3, 27), ((0, 0, 0), 0))

     

       5
        
       

     

       6
        
       let setup_fixed_date () =

     

       7
       -
         (Date.get_today := fun () -> fixed_date);

     

       8
        
         fixed_date

     

       9
        
       

     

       10
        
       let test_parse_date () =

     

       11
        
         let test_expr expr parameter expected =

     

       12
        
           try

     

       13
       -
             let result = Query.parse_date expr parameter in

     

       14
        
             let result_str =

     

       15
        
               let y, m, d = Ptime.to_date result in

     

       16
        
               Printf.sprintf "%04d-%02d-%02d" y m d

     
···

       47
        
         test_expr "+1m" `To "2025-04-30";

     

       48
        
         test_expr "2025-01-01" `From "2025-01-01";

     

       49
        
         test_expr "2025-01-01" `To "2025-01-01";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       50
        
         (try

     

       51
       -
            let _ = Query.parse_date "invalid-format" `From in

     

       52
        
            Alcotest.fail "Should have raised an exception for invalid format"

     

       53
        
          with Failure msg ->

     

       54
        
            Alcotest.(check bool)

     
···

       56
        
              (String.length msg > 0));

     

       57
        
         ()

     

       58
        
       

     

       59
       -
       let date_tests fs = [ ("date expression parsing", `Quick, test_parse_date) ]

     

       60
        
       

     

       61
        
       let () =

     

       62
       -
         Eio_main.run @@ fun env ->

     

       63
       -
         let fs = Eio.Stdenv.fs env in

     

       64
        
         let _ = setup_fixed_date () in

     

       65
       -
         Alcotest.run "Query Tests" [ ("query", date_tests fs) ]

···

       1
        
       (* Test the Date module *)

     

       2
        
       

     

       3
       +
       open Caledonia_lib

     

       4
       +
       

     

       5
        
       (* Setup a fixed date for testing *)

     

       6
        
       let fixed_date = Option.get @@ Ptime.of_date_time ((2025, 3, 27), ((0, 0, 0), 0))

     

       7
        
       

     

       8
        
       let setup_fixed_date () =

     

       9
       +
         (Date.get_today := fun ?tz:_ () -> fixed_date);

     

       10
        
         fixed_date

     

       11
        
       

     

       12
        
       let test_parse_date () =

     

       13
        
         let test_expr expr parameter expected =

     

       14
        
           try

     

       15
       +
             let result = Result.get_ok @@ Date.parse_date expr parameter in

     

       16
        
             let result_str =

     

       17
        
               let y, m, d = Ptime.to_date result in

     

       18
        
               Printf.sprintf "%04d-%02d-%02d" y m d

     
···

       49
        
         test_expr "+1m" `To "2025-04-30";

     

       50
        
         test_expr "2025-01-01" `From "2025-01-01";

     

       51
        
         test_expr "2025-01-01" `To "2025-01-01";

     

       52
       +
         test_expr "2025-01" `From "2025-01-01";

     

       53
       +
         test_expr "2025-01" `To "2025-01-01";

     

       54
       +
         test_expr "2025" `From "2025-01-01";

     

       55
       +
         test_expr "2025" `To "2025-01-01";

     

       56
       +
         test_expr "2025-3-1" `From "2025-03-01";

     

       57
       +
         test_expr "2025-3-1" `To "2025-03-01";

     

       58
        
         (try

     

       59
       +
            let _ = Result.get_ok @@ Date.parse_date "invalid-format" `From in

     

       60
        
            Alcotest.fail "Should have raised an exception for invalid format"

     

       61
        
          with Failure msg ->

     

       62
        
            Alcotest.(check bool)

     
···

       64
        
              (String.length msg > 0));

     

       65
        
         ()

     

       66
        
       

     

       67
       +
       let date_tests = [ ("date expression parsing", `Quick, test_parse_date) ]

     

       68
        
       

     

       69
        
       let () =

     

       0
        
       
     

       0
        
       
     

       70
        
         let _ = setup_fixed_date () in

     

       71
       +
         Alcotest.run "Query Tests" [ ("query", date_tests) ]

+322

test/test_event.ml

···

       1
       +
       (* Test the Query module *)

     

       2
       +
       

     

       3
       +
       open Caledonia_lib

     

       4
       +
       

     

       5
       +
       (* Setup a fixed date for testing *)

     

       6
       +
       let fixed_date = Option.get @@ Ptime.of_date_time ((2025, 3, 27), ((0, 0, 0), 0))

     

       7
       +
       

     

       8
       +
       let setup_fixed_date () =

     

       9
       +
         (Date.get_today := fun ?tz:_ () -> fixed_date);

     

       10
       +
         fixed_date

     

       11
       +
       

     

       12
       +
       let calendar_dir_path = Filename.concat (Sys.getcwd ()) "calendar"

     

       13
       +
       

     

       14
       +
       let test_query_all ~fs () =

     

       15
       +
         let calendar_dir =

     

       16
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       17
       +
         in

     

       18
       +
         let from =

     

       19
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       20
       +
         in

     

       21
       +
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       22
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       23
       +
         let events = Event.query events ~from ~to_ () in

     

       24
       +
         Alcotest.(check int) "Should find events" 791 (List.length events);

     

       25
       +
         let test_event =

     

       26
       +
           List.find_opt

     

       27
       +
             (fun event -> Option.get @@ Event.get_summary event = "Test Event")

     

       28
       +
             events

     

       29
       +
         in

     

       30
       +
         Alcotest.(check bool) "Should find Test Event" true (test_event <> None)

     

       31
       +
       

     

       32
       +
       let test_recurrence_expansion ~fs () =

     

       33
       +
         let calendar_dir =

     

       34
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       35
       +
         in

     

       36
       +
         let from =

     

       37
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 3, 1), ((0, 0, 0), 0)))

     

       38
       +
         in

     

       39
       +
         let to_ =

     

       40
       +
           Option.get @@ Ptime.of_date_time ((2025, 5, 31), ((23, 59, 59), 0))

     

       41
       +
         in

     

       42
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       43
       +
         let events = Event.query events ~from ~to_ () in

     

       44
       +
         let recurring_events =

     

       45
       +
           List.filter

     

       46
       +
             (fun event -> Option.get @@ Event.get_summary event = "Recurring Event")

     

       47
       +
             events

     

       48
       +
         in

     

       49
       +
         Alcotest.(check bool)

     

       50
       +
           "Should find multiple recurring event events" true

     

       51
       +
           (List.length recurring_events > 1)

     

       52
       +
       

     

       53
       +
       let test_text_search ~fs () =

     

       54
       +
         let calendar_dir =

     

       55
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       56
       +
         in

     

       57
       +
         let filter = Event.summary_contains "Test" in

     

       58
       +
         let from =

     

       59
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       60
       +
         in

     

       61
       +
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       62
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       63
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       64
       +
          Alcotest.(check int)

     

       65
       +
            "Should find event with 'Test' in summary" 2 (List.length events));

     

       66
       +
         let filter = Event.location_contains "Weekly" in

     

       67
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       68
       +
          Alcotest.(check int)

     

       69
       +
            "Should find event with 'Weekly' in location" 10 (List.length events));

     

       70
       +
         let filter =

     

       71
       +
           Event.and_filter

     

       72
       +
             [ Event.summary_contains "Test"; Event.description_contains "test" ]

     

       73
       +
         in

     

       74
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       75
       +
          Alcotest.(check int)

     

       76
       +
            "Should find events matching combined and criteria" 2 (List.length events));

     

       77
       +
         let filter =

     

       78
       +
           Event.or_filter

     

       79
       +
             [ Event.summary_contains "Test"; Event.location_contains "Weekly" ]

     

       80
       +
         in

     

       81
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       82
       +
          Alcotest.(check int)

     

       83
       +
            "Should find events matching combined or criteria" 12 (List.length events));

     

       84
       +
         ()

     

       85
       +
       

     

       86
       +
       let test_calendar_filter ~fs () =

     

       87
       +
         let calendar_dir =

     

       88
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       89
       +
         in

     

       90
       +
         let from =

     

       91
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       92
       +
         in

     

       93
       +
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       94
       +
         let calendar_name = "example" in

     

       95
       +
         let filter = Event.in_calendars [ calendar_name ] in

     

       96
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       97
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       98
       +
          let all_match_calendar =

     

       99
       +
            List.for_all

     

       100
       +
              (fun e ->

     

       101
       +
                match Event.get_calendar_name e with id -> id = calendar_name)

     

       102
       +
              events

     

       103
       +
          in

     

       104
       +
          Alcotest.(check bool)

     

       105
       +
            (Printf.sprintf "All events should be from calendar '%s'" calendar_name)

     

       106
       +
            true all_match_calendar;

     

       107
       +
          Alcotest.(check int) "Should find events" 2 (List.length events));

     

       108
       +
         let calendar_names = [ "example"; "recurrence" ] in

     

       109
       +
         let filter = Event.in_calendars calendar_names in

     

       110
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       111
       +
          Alcotest.(check int) "Should find events" 791 (List.length events));

     

       112
       +
         let filter = Event.in_calendars [ "non-existent-calendar" ] in

     

       113
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       114
       +
          Alcotest.(check int)

     

       115
       +
            "Should find 0 events for non-existent calendar" 0 (List.length events));

     

       116
       +
         ()

     

       117
       +
       

     

       118
       +
       let test_events ~fs =

     

       119
       +
         (* Create a test event with specific text in all fields *)

     

       120
       +
         let create_test_event ~calendar_name ~summary ~description ~location ~start =

     

       121
       +
           Event.create ~fs ~calendar_dir_path ~summary ~start

     

       122
       +
             ?description:(if description = "" then None else Some description)

     

       123
       +
             ?location:(if location = "" then None else Some location)

     

       124
       +
             calendar_name

     

       125
       +
         in

     

       126
       +
         [

     

       127
       +
           (* Event with text in all fields *)

     

       128
       +
           Result.get_ok

     

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

     

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

     

       131
       +
                ~location:"Conference Room A"

     

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

     

       133
       +
           (* Event with mixed case to test case insensitivity *)

     

       134
       +
           Result.get_ok

     

       135
       +
           @@ create_test_event ~calendar_name:"search_test"

     

       136
       +
                ~summary:"IMPORTANT Meeting"

     

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

     

       138
       +
                ~location:"Executive Suite"

     

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

     

       140
       +
           (* Event with word fragments *)

     

       141
       +
           Result.get_ok

     

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

     

       143
       +
                ~description:"International conference preparation"

     

       144
       +
                ~location:"Remote Meeting Room"

     

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

     

       146
       +
           (* Event with unique text in each field *)

     

       147
       +
           Result.get_ok

     

       148
       +
           @@ create_test_event ~calendar_name:"search_test"

     

       149
       +
                ~summary:"Workshop on Testing"

     

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

     

       151
       +
                ~location:"Training Center"

     

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

     

       153
       +
         ]

     

       154
       +
       

     

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

     

       156
       +
       let contains_summary events summary =

     

       157
       +
         List.exists

     

       158
       +
           (fun e -> String.equal (Option.get @@ Event.get_summary e) summary)

     

       159
       +
           events

     

       160
       +
       

     

       161
       +
       let test_case_insensitive_search ~fs () =

     

       162
       +
         (* Test lowercase query for an uppercase word *)

     

       163
       +
         let lowercase_filter = Event.summary_contains "important" in

     

       164
       +
         let matches =

     

       165
       +
           List.filter

     

       166
       +
             (fun e -> Event.matches_filter e lowercase_filter)

     

       167
       +
             (test_events ~fs)

     

       168
       +
         in

     

       169
       +
         Alcotest.(check bool)

     

       170
       +
           "Lowercase query should match uppercase text in summary" true

     

       171
       +
           (contains_summary matches "IMPORTANT Meeting");

     

       172
       +
         (* Test uppercase query for a lowercase word *)

     

       173
       +
         let uppercase_filter = Event.description_contains "WEEKLY" in

     

       174
       +
         let matches =

     

       175
       +
           List.filter

     

       176
       +
             (fun e -> Event.matches_filter e uppercase_filter)

     

       177
       +
             (test_events ~fs)

     

       178
       +
         in

     

       179
       +
         Alcotest.(check bool)

     

       180
       +
           "Uppercase query should match lowercase text in description" true

     

       181
       +
           (contains_summary matches "Project Meeting")

     

       182
       +
       

     

       183
       +
       let test_partial_word_matching ~fs () =

     

       184
       +
         (* Test searching for part of a word *)

     

       185
       +
         let partial_filter = Event.summary_contains "Conf" in

     

       186
       +
         (* Should match "Conference" *)

     

       187
       +
         let matches =

     

       188
       +
           List.filter

     

       189
       +
             (fun e -> Event.matches_filter e partial_filter)

     

       190
       +
             (test_events ~fs)

     

       191
       +
         in

     

       192
       +
         Alcotest.(check bool)

     

       193
       +
           "Partial query should match full word in summary" true

     

       194
       +
           (contains_summary matches "Conference Call");

     

       195
       +
         (* Test another partial word in description *)

     

       196
       +
         let partial_filter = Event.description_contains "nation" in

     

       197
       +
         (* Should match "International" *)

     

       198
       +
         let matches =

     

       199
       +
           List.filter

     

       200
       +
             (fun e -> Event.matches_filter e partial_filter)

     

       201
       +
             (test_events ~fs)

     

       202
       +
         in

     

       203
       +
         Alcotest.(check bool)

     

       204
       +
           "Partial query should match within word in description" true

     

       205
       +
           (contains_summary matches "Conference Call");

     

       206
       +
       

     

       207
       +
         Alcotest.(check bool)

     

       208
       +
           "Partial query should match within word in description" true

     

       209
       +
           (contains_summary matches "Conference Call")

     

       210
       +
       

     

       211
       +
       let test_boolean_logic ~fs () =

     

       212
       +
         (* Test AND filter *)

     

       213
       +
         let and_filter =

     

       214
       +
           Event.and_filter

     

       215
       +
             [ Event.summary_contains "Meeting"; Event.description_contains "project" ]

     

       216
       +
         in

     

       217
       +
         let matches =

     

       218
       +
           List.filter (fun e -> Event.matches_filter e and_filter) (test_events ~fs)

     

       219
       +
         in

     

       220
       +
         Alcotest.(check int)

     

       221
       +
           "AND filter should match events with both terms" 2

     

       222
       +
           (* Two events have both "Meeting" in summary and "project" in description *)

     

       223
       +
           (List.length matches);

     

       224
       +
         (* Test OR filter *)

     

       225
       +
         let or_filter =

     

       226
       +
           Event.or_filter

     

       227
       +
             [ Event.summary_contains "Workshop"; Event.summary_contains "Conference" ]

     

       228
       +
         in

     

       229
       +
         let matches =

     

       230
       +
           List.filter (fun e -> Event.matches_filter e or_filter) (test_events ~fs)

     

       231
       +
         in

     

       232
       +
         Alcotest.(check int)

     

       233
       +
           "OR filter should match events with either term"

     

       234
       +
           2 (* One event has "Workshop", one has "Conference" *)

     

       235
       +
           (List.length matches);

     

       236
       +
       

     

       237
       +
         (* Test NOT filter *)

     

       238
       +
         let not_filter = Event.not_filter (Event.summary_contains "Meeting") in

     

       239
       +
         let matches =

     

       240
       +
           List.filter (fun e -> Event.matches_filter e not_filter) (test_events ~fs)

     

       241
       +
         in

     

       242
       +
         Alcotest.(check int)

     

       243
       +
           "NOT filter should match events without the term"

     

       244
       +
           2 (* Two events don't have "Meeting" in the summary *)

     

       245
       +
           (List.length matches);

     

       246
       +
         (* Test complex combination: (Meeting AND project) OR Workshop BUT NOT Conference *)

     

       247
       +
         let complex_filter =

     

       248
       +
           Event.and_filter

     

       249
       +
             [

     

       250
       +
               Event.or_filter

     

       251
       +
                 [

     

       252
       +
                   Event.and_filter

     

       253
       +
                     [

     

       254
       +
                       Event.summary_contains "Meeting";

     

       255
       +
                       Event.description_contains "project";

     

       256
       +
                     ];

     

       257
       +
                   Event.summary_contains "Workshop";

     

       258
       +
                 ];

     

       259
       +
               Event.not_filter (Event.summary_contains "Conference");

     

       260
       +
             ]

     

       261
       +
         in

     

       262
       +
         let matches =

     

       263
       +
           List.filter

     

       264
       +
             (fun e -> Event.matches_filter e complex_filter)

     

       265
       +
             (test_events ~fs)

     

       266
       +
         in

     

       267
       +
         Alcotest.(check int)

     

       268
       +
           "Complex filter should match correctly"

     

       269
       +
           3 (* Three events should match the complex criteria *)

     

       270
       +
           (List.length matches)

     

       271
       +
       

     

       272
       +
       let test_cross_field_search ~fs () =

     

       273
       +
         (* Search for a term that appears in multiple fields across different events *)

     

       274
       +
         let term_filter =

     

       275
       +
           Event.or_filter

     

       276
       +
             [

     

       277
       +
               Event.summary_contains "meeting";

     

       278
       +
               Event.description_contains "meeting";

     

       279
       +
               Event.location_contains "meeting";

     

       280
       +
             ]

     

       281
       +
         in

     

       282
       +
         let matches =

     

       283
       +
           List.filter (fun e -> Event.matches_filter e term_filter) (test_events ~fs)

     

       284
       +
         in

     

       285
       +
         Alcotest.(check int)

     

       286
       +
           "Cross-field search should find all occurrences"

     

       287
       +
           3 (* "meeting" appears in 3 events across different fields *)

     

       288
       +
           (List.length matches);

     

       289
       +
         (* Another test with a different term *)

     

       290
       +
         let term_filter =

     

       291
       +
           Event.or_filter

     

       292
       +
             [

     

       293
       +
               Event.summary_contains "conference";

     

       294
       +
               Event.description_contains "conference";

     

       295
       +
               Event.location_contains "conference";

     

       296
       +
             ]

     

       297
       +
         in

     

       298
       +
         let matches =

     

       299
       +
           List.filter (fun e -> Event.matches_filter e term_filter) (test_events ~fs)

     

       300
       +
         in

     

       301
       +
         Alcotest.(check int)

     

       302
       +
           "Cross-field search should find all occurrences of 'conference'"

     

       303
       +
           2 (* "conference" appears in 2 events across different fields *)

     

       304
       +
           (List.length matches)

     

       305
       +
       

     

       306
       +
       let query_tests fs =

     

       307
       +
         [

     

       308
       +
           ("query all events", `Quick, test_query_all ~fs);

     

       309
       +
           ("recurrence expansion", `Quick, test_recurrence_expansion ~fs);

     

       310
       +
           ("text search", `Quick, test_text_search ~fs);

     

       311
       +
           ("calendar filter", `Quick, test_calendar_filter ~fs);

     

       312
       +
           ("case insensitive search", `Quick, test_case_insensitive_search ~fs);

     

       313
       +
           ("partial word matching", `Quick, test_partial_word_matching ~fs);

     

       314
       +
           ("boolean logic filters", `Quick, test_boolean_logic ~fs);

     

       315
       +
           ("cross-field searching", `Quick, test_cross_field_search ~fs);

     

       316
       +
         ]

     

       317
       +
       

     

       318
       +
       let () =

     

       319
       +
         Eio_main.run @@ fun env ->

     

       320
       +
         let fs = Eio.Stdenv.fs env in

     

       321
       +
         let _ = setup_fixed_date () in

     

       322
       +
         Alcotest.run "Query Tests" [ ("query", query_tests fs) ]

-326

test/test_query.ml

···

       1
       -
       (* Test the Query module *)

     

       2
       -
       

     

       3
       -
       open Caledonia_lib

     

       4
       -
       

     

       5
       -
       (* Setup a fixed date for testing *)

     

       6
       -
       let fixed_date = Option.get @@ Ptime.of_date_time ((2025, 3, 27), ((0, 0, 0), 0))

     

       7
       -
       

     

       8
       -
       let setup_fixed_date () =

     

       9
       -
         (Date.get_today := fun () -> fixed_date);

     

       10
       -
         fixed_date

     

       11
       -
       

     

       12
       -
       let calendar_dir_path = Filename.concat (Sys.getcwd ()) "calendar"

     

       13
       -
       

     

       14
       -
       let test_query_all ~fs () =

     

       15
       -
         let calendar_dir =

     

       16
       -
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       17
       -
         in

     

       18
       -
         let from =

     

       19
       -
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       20
       -
         in

     

       21
       -
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       22
       -
         match Query.query ~fs calendar_dir ~from ~to_ () with

     

       23
       -
         | Ok instances ->

     

       24
       -
             Alcotest.(check int) "Should find events" 792 (List.length instances);

     

       25
       -
             let test_event =

     

       26
       -
               List.find_opt

     

       27
       -
                 (fun instance ->

     

       28
       -
                   Option.get @@ Event.get_summary instance.Recur.event = "Test Event")

     

       29
       -
                 instances

     

       30
       -
             in

     

       31
       -
             Alcotest.(check bool) "Should find Test Event" true (test_event <> None)

     

       32
       -
         | Error _ -> Alcotest.fail "Error querying events"

     

       33
       -
       

     

       34
       -
       let test_recurrence_expansion ~fs () =

     

       35
       -
         let calendar_dir =

     

       36
       -
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       37
       -
         in

     

       38
       -
         let from =

     

       39
       -
           Some (Option.get @@ Ptime.of_date_time ((2025, 3, 1), ((0, 0, 0), 0)))

     

       40
       -
         in

     

       41
       -
         let to_ =

     

       42
       -
           Option.get @@ Ptime.of_date_time ((2025, 5, 31), ((23, 59, 59), 0))

     

       43
       -
         in

     

       44
       -
         match Query.query ~fs calendar_dir ~from ~to_ () with

     

       45
       -
         | Ok instances ->

     

       46
       -
             let recurring_instances =

     

       47
       -
               List.filter

     

       48
       -
                 (fun instance ->

     

       49
       -
                   Option.get @@ Event.get_summary instance.Recur.event

     

       50
       -
                   = "Recurring Event")

     

       51
       -
                 instances

     

       52
       -
             in

     

       53
       -
             Alcotest.(check bool)

     

       54
       -
               "Should find multiple recurring event instances" true

     

       55
       -
               (List.length recurring_instances > 1)

     

       56
       -
         | Error _ -> Alcotest.fail "Error querying events"

     

       57
       -
       

     

       58
       -
       let test_text_search ~fs () =

     

       59
       -
         let calendar_dir =

     

       60
       -
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       61
       -
         in

     

       62
       -
         let filter = Query.summary_contains "Test" in

     

       63
       -
         let from =

     

       64
       -
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       65
       -
         in

     

       66
       -
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       67
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       68
       -
         | Ok instances ->

     

       69
       -
             Alcotest.(check int)

     

       70
       -
               "Should find event with 'Test' in summary" 2 (List.length instances)

     

       71
       -
         | Error _ -> Alcotest.fail "Error querying events");

     

       72
       -
         let filter = Query.location_contains "Weekly" in

     

       73
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       74
       -
         | Ok instances ->

     

       75
       -
             Alcotest.(check int)

     

       76
       -
               "Should find event with 'Weekly' in location" 10 (List.length instances)

     

       77
       -
         | Error _ -> Alcotest.fail "Error querying events");

     

       78
       -
         let filter =

     

       79
       -
           Query.and_filter

     

       80
       -
             [ Query.summary_contains "Test"; Query.description_contains "test" ]

     

       81
       -
         in

     

       82
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       83
       -
         | Ok instances ->

     

       84
       -
             Alcotest.(check int)

     

       85
       -
               "Should find events matching combined and criteria" 2

     

       86
       -
               (List.length instances)

     

       87
       -
         | Error _ -> Alcotest.fail "Error querying events");

     

       88
       -
         let filter =

     

       89
       -
           Query.or_filter

     

       90
       -
             [ Query.summary_contains "Test"; Query.location_contains "Weekly" ]

     

       91
       -
         in

     

       92
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       93
       -
         | Ok instances ->

     

       94
       -
             Alcotest.(check int)

     

       95
       -
               "Should find events matching combined or criteria" 12

     

       96
       -
               (List.length instances)

     

       97
       -
         | Error _ -> Alcotest.fail "Error querying events");

     

       98
       -
         ()

     

       99
       -
       

     

       100
       -
       let test_calendar_filter ~fs () =

     

       101
       -
         let calendar_dir =

     

       102
       -
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       103
       -
         in

     

       104
       -
         let from =

     

       105
       -
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       106
       -
         in

     

       107
       -
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       108
       -
         let collection = Collection.Col "example" in

     

       109
       -
         let filter = Query.in_collections [ collection ] in

     

       110
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       111
       -
         | Ok instances ->

     

       112
       -
             let all_match_calendar =

     

       113
       -
               List.for_all

     

       114
       -
                 (fun e ->

     

       115
       -
                   match Event.get_collection e.Recur.event with

     

       116
       -
                   | id -> id = collection)

     

       117
       -
                 instances

     

       118
       -
             in

     

       119
       -
             Alcotest.(check bool)

     

       120
       -
               (Printf.sprintf "All events should be from calendar '%s'"

     

       121
       -
                  (match collection with Col str -> str))

     

       122
       -
               true all_match_calendar;

     

       123
       -
             Alcotest.(check int) "Should find events" 2 (List.length instances)

     

       124
       -
         | Error _ -> Alcotest.fail "Error querying events");

     

       125
       -
         let collections = [ Collection.Col "example"; Collection.Col "recurrence" ] in

     

       126
       -
         let filter = Query.in_collections collections in

     

       127
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       128
       -
         | Ok instances ->

     

       129
       -
             Alcotest.(check int) "Should find events" 792 (List.length instances)

     

       130
       -
         | Error _ -> Alcotest.fail "Error querying events");

     

       131
       -
         let filter =

     

       132
       -
           Query.in_collections [ Collection.Col "non-existent-calendar" ]

     

       133
       -
         in

     

       134
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       135
       -
         | Ok instances ->

     

       136
       -
             Alcotest.(check int)

     

       137
       -
               "Should find 0 events for non-existent calendar" 0

     

       138
       -
               (List.length instances)

     

       139
       -
         | Error _ -> Alcotest.fail "Error querying events");

     

       140
       -
         ()

     

       141
       -
       

     

       142
       -
       let test_events =

     

       143
       -
         (* Create a test event with specific text in all fields *)

     

       144
       -
         let create_test_event ~collection ~summary ~description ~location ~start =

     

       145
       -
           Event.create ~summary ~start

     

       146
       -
             ?description:(if description = "" then None else Some description)

     

       147
       -
             ?location:(if location = "" then None else Some location)

     

       148
       -
             (Collection.Col collection)

     

       149
       -
         in

     

       150
       -
         [

     

       151
       -
           (* Event with text in all fields *)

     

       152
       -
           create_test_event ~collection:"search_test" ~summary:"Project Meeting"

     

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

     

       154
       -
             ~location:"Conference Room A" ~start:fixed_date;

     

       155
       -
           (* Event with mixed case to test case insensitivity *)

     

       156
       -
           create_test_event ~collection:"search_test" ~summary:"IMPORTANT Meeting"

     

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

     

       158
       -
             ~location:"Executive Suite" ~start:fixed_date;

     

       159
       -
           (* Event with word fragments *)

     

       160
       -
           create_test_event ~collection:"search_test" ~summary:"Conference Call"

     

       161
       -
             ~description:"International conference preparation"

     

       162
       -
             ~location:"Remote Meeting Room" ~start:fixed_date;

     

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

     

       164
       -
           create_test_event ~collection:"search_test" ~summary:"Workshop on Testing"

     

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

     

       166
       -
             ~location:"Training Center" ~start:fixed_date;

     

       167
       -
         ]

     

       168
       -
       

     

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

     

       170
       -
       let contains_summary events summary =

     

       171
       -
         List.exists

     

       172
       -
           (fun e -> String.equal (Option.get @@ Event.get_summary e) summary)

     

       173
       -
           events

     

       174
       -
       

     

       175
       -
       let test_case_insensitive_search () =

     

       176
       -
         (* Test lowercase query for an uppercase word *)

     

       177
       -
         let lowercase_filter = Query.summary_contains "important" in

     

       178
       -
         let matches =

     

       179
       -
           List.filter (fun e -> Query.matches_filter e lowercase_filter) test_events

     

       180
       -
         in

     

       181
       -
         Alcotest.(check bool)

     

       182
       -
           "Lowercase query should match uppercase text in summary" true

     

       183
       -
           (contains_summary matches "IMPORTANT Meeting");

     

       184
       -
         (* Test uppercase query for a lowercase word *)

     

       185
       -
         let uppercase_filter = Query.description_contains "WEEKLY" in

     

       186
       -
         let matches =

     

       187
       -
           List.filter (fun e -> Query.matches_filter e uppercase_filter) test_events

     

       188
       -
         in

     

       189
       -
         Alcotest.(check bool)

     

       190
       -
           "Uppercase query should match lowercase text in description" true

     

       191
       -
           (contains_summary matches "Project Meeting")

     

       192
       -
       

     

       193
       -
       let test_partial_word_matching () =

     

       194
       -
         (* Test searching for part of a word *)

     

       195
       -
         let partial_filter = Query.summary_contains "Conf" in

     

       196
       -
         (* Should match "Conference" *)

     

       197
       -
         let matches =

     

       198
       -
           List.filter (fun e -> Query.matches_filter e partial_filter) test_events

     

       199
       -
         in

     

       200
       -
         Alcotest.(check bool)

     

       201
       -
           "Partial query should match full word in summary" true

     

       202
       -
           (contains_summary matches "Conference Call");

     

       203
       -
         (* Test another partial word in description *)

     

       204
       -
         let partial_filter = Query.description_contains "nation" in

     

       205
       -
         (* Should match "International" *)

     

       206
       -
         let matches =

     

       207
       -
           List.filter (fun e -> Query.matches_filter e partial_filter) test_events

     

       208
       -
         in

     

       209
       -
         Alcotest.(check bool)

     

       210
       -
           "Partial query should match within word in description" true

     

       211
       -
           (contains_summary matches "Conference Call");

     

       212
       -
       

     

       213
       -
         Alcotest.(check bool)

     

       214
       -
           "Partial query should match within word in description" true

     

       215
       -
           (contains_summary matches "Conference Call")

     

       216
       -
       

     

       217
       -
       let test_boolean_logic () =

     

       218
       -
         (* Test AND filter *)

     

       219
       -
         let and_filter =

     

       220
       -
           Query.and_filter

     

       221
       -
             [ Query.summary_contains "Meeting"; Query.description_contains "project" ]

     

       222
       -
         in

     

       223
       -
         let matches =

     

       224
       -
           List.filter (fun e -> Query.matches_filter e and_filter) test_events

     

       225
       -
         in

     

       226
       -
         Alcotest.(check int)

     

       227
       -
           "AND filter should match events with both terms" 2

     

       228
       -
           (* Two events have both "Meeting" in summary and "project" in description *)

     

       229
       -
           (List.length matches);

     

       230
       -
         (* Test OR filter *)

     

       231
       -
         let or_filter =

     

       232
       -
           Query.or_filter

     

       233
       -
             [ Query.summary_contains "Workshop"; Query.summary_contains "Conference" ]

     

       234
       -
         in

     

       235
       -
         let matches =

     

       236
       -
           List.filter (fun e -> Query.matches_filter e or_filter) test_events

     

       237
       -
         in

     

       238
       -
         Alcotest.(check int)

     

       239
       -
           "OR filter should match events with either term"

     

       240
       -
           2 (* One event has "Workshop", one has "Conference" *)

     

       241
       -
           (List.length matches);

     

       242
       -
       

     

       243
       -
         (* Test NOT filter *)

     

       244
       -
         let not_filter = Query.not_filter (Query.summary_contains "Meeting") in

     

       245
       -
         let matches =

     

       246
       -
           List.filter (fun e -> Query.matches_filter e not_filter) test_events

     

       247
       -
         in

     

       248
       -
         Alcotest.(check int)

     

       249
       -
           "NOT filter should match events without the term"

     

       250
       -
           2 (* Two events don't have "Meeting" in the summary *)

     

       251
       -
           (List.length matches);

     

       252
       -
         (* Test complex combination: (Meeting AND project) OR Workshop BUT NOT Conference *)

     

       253
       -
         let complex_filter =

     

       254
       -
           Query.and_filter

     

       255
       -
             [

     

       256
       -
               Query.or_filter

     

       257
       -
                 [

     

       258
       -
                   Query.and_filter

     

       259
       -
                     [

     

       260
       -
                       Query.summary_contains "Meeting";

     

       261
       -
                       Query.description_contains "project";

     

       262
       -
                     ];

     

       263
       -
                   Query.summary_contains "Workshop";

     

       264
       -
                 ];

     

       265
       -
               Query.not_filter (Query.summary_contains "Conference");

     

       266
       -
             ]

     

       267
       -
         in

     

       268
       -
         let matches =

     

       269
       -
           List.filter (fun e -> Query.matches_filter e complex_filter) test_events

     

       270
       -
         in

     

       271
       -
         Alcotest.(check int)

     

       272
       -
           "Complex filter should match correctly"

     

       273
       -
           3 (* Three events should match the complex criteria *)

     

       274
       -
           (List.length matches)

     

       275
       -
       

     

       276
       -
       let test_cross_field_search () =

     

       277
       -
         (* Search for a term that appears in multiple fields across different events *)

     

       278
       -
         let term_filter =

     

       279
       -
           Query.or_filter

     

       280
       -
             [

     

       281
       -
               Query.summary_contains "meeting";

     

       282
       -
               Query.description_contains "meeting";

     

       283
       -
               Query.location_contains "meeting";

     

       284
       -
             ]

     

       285
       -
         in

     

       286
       -
         let matches =

     

       287
       -
           List.filter (fun e -> Query.matches_filter e term_filter) test_events

     

       288
       -
         in

     

       289
       -
         Alcotest.(check int)

     

       290
       -
           "Cross-field search should find all occurrences"

     

       291
       -
           3 (* "meeting" appears in 3 events across different fields *)

     

       292
       -
           (List.length matches);

     

       293
       -
         (* Another test with a different term *)

     

       294
       -
         let term_filter =

     

       295
       -
           Query.or_filter

     

       296
       -
             [

     

       297
       -
               Query.summary_contains "conference";

     

       298
       -
               Query.description_contains "conference";

     

       299
       -
               Query.location_contains "conference";

     

       300
       -
             ]

     

       301
       -
         in

     

       302
       -
         let matches =

     

       303
       -
           List.filter (fun e -> Query.matches_filter e term_filter) test_events

     

       304
       -
         in

     

       305
       -
         Alcotest.(check int)

     

       306
       -
           "Cross-field search should find all occurrences of 'conference'"

     

       307
       -
           2 (* "conference" appears in 2 events across different fields *)

     

       308
       -
           (List.length matches)

     

       309
       -
       

     

       310
       -
       let query_tests fs =

     

       311
       -
         [

     

       312
       -
           ("query all events", `Quick, test_query_all ~fs);

     

       313
       -
           ("recurrence expansion", `Quick, test_recurrence_expansion ~fs);

     

       314
       -
           ("text search", `Quick, test_text_search ~fs);

     

       315
       -
           ("calendar filter", `Quick, test_calendar_filter ~fs);

     

       316
       -
           ("case insensitive search", `Quick, test_case_insensitive_search);

     

       317
       -
           ("partial word matching", `Quick, test_partial_word_matching);

     

       318
       -
           ("boolean logic filters", `Quick, test_boolean_logic);

     

       319
       -
           ("cross-field searching", `Quick, test_cross_field_search);

     

       320
       -
         ]

     

       321
       -
       

     

       322
       -
       let () =

     

       323
       -
         Eio_main.run @@ fun env ->

     

       324
       -
         let fs = Eio.Stdenv.fs env in

     

       325
       -
         let _ = setup_fixed_date () in

     

       326
       -
         Alcotest.run "Query Tests" [ ("query", query_tests fs) ]

-737

test/test_recur.ml

···

       1
       -
       (* Test recurrence expansion for specific event file.

     

       2
       -
          More tests can be found in the icalendar library at test/test_recur.ml *)

     

       3
       -
       

     

       4
       -
       open Caledonia_lib

     

       5
       -
       

     

       6
       -
       let test_recurring_events_in_date_range () =

     

       7
       -
         (* Create a recurring event that starts BEFORE our test range *)

     

       8
       -
         let event_start =

     

       9
       -
           Option.get @@ Ptime.of_date_time ((2025, 2, 1), ((14, 0, 0), 0))

     

       10
       -
         in

     

       11
       -
         let recurrence = (`Weekly, None, Some 1, []) in

     

       12
       -
         (* Weekly recurrence *)

     

       13
       -
         let recurring_event =

     

       14
       -
           Event.create ~summary:"Weekly Recurring Event" ~start:event_start

     

       15
       -
             ~recurrence (Collection.Col "test")

     

       16
       -
         in

     

       17
       -
         let test_date_range from_str to_str expected_count =

     

       18
       -
           try

     

       19
       -
             let from = Some (Result.get_ok @@ Date.parse_date from_str `From) in

     

       20
       -
             let to_ = Result.get_ok @@ Date.parse_date to_str `To in

     

       21
       -
             let instances = Recur.expand_event recurring_event ~from ~to_ in

     

       22
       -
             Printf.printf "Testing date range: %s to %s\n" from_str to_str;

     

       23
       -
             Printf.printf "Found %d instances:\n" (List.length instances);

     

       24
       -
             List.iter

     

       25
       -
               (fun i ->

     

       26
       -
                 let date_str =

     

       27
       -
                   let y, m, d = Ptime.to_date i.Recur.start in

     

       28
       -
                   Printf.sprintf "%04d-%02d-%02d" y m d

     

       29
       -
                 in

     

       30
       -
                 let time_str =

     

       31
       -
                   let _, ((h, m, s), _) = Ptime.to_date_time i.Recur.start in

     

       32
       -
                   Printf.sprintf "%02d:%02d:%02d" h m s

     

       33
       -
                 in

     

       34
       -
                 Printf.printf "  - %s %s\n" date_str time_str)

     

       35
       -
               instances;

     

       36
       -
             (* Check the count matches what we expect *)

     

       37
       -
             Alcotest.(check int)

     

       38
       -
               (Printf.sprintf "Date range %s to %s should have %d occurrences"

     

       39
       -
                  from_str to_str expected_count)

     

       40
       -
               expected_count (List.length instances)

     

       41
       -
           with Failure msg ->

     

       42
       -
             Alcotest.fail

     

       43
       -
               (Printf.sprintf "Failed to parse date range '%s' to '%s': %s" from_str

     

       44
       -
                  to_str msg)

     

       45
       -
         in

     

       46
       -
         test_date_range "2025-01-25" "2025-01-31" 0;

     

       47
       -
         test_date_range "2025-02-01" "2025-02-02" 1;

     

       48
       -
         test_date_range "2025-02-01" "2025-02-14" 2;

     

       49
       -
         test_date_range "2025-02-01" "2025-02-15" 2;

     

       50
       -
         (* Event started in February, but query range is only in March *)

     

       51
       -
         test_date_range "2025-03-01" "2025-03-31" 5;

     

       52
       -
         (* Specific test for the March 8 instance *)

     

       53
       -
         test_date_range "2025-03-08" "2025-03-09" 1;

     

       54
       -
         (* Test a range that spans original event date and later dates *)

     

       55
       -
         test_date_range "2025-01-15" "2025-03-15" 6;

     

       56
       -
         ()

     

       57
       -
       

     

       58
       -
       let test_dir = Filename.concat (Sys.getcwd ()) "calendar/recurrence/"

     

       59
       -
       let day_seconds = 86400

     

       60
       -
       

     

       61
       -
       (* Parse date string in YYYY-MM-DD format *)

     

       62
       -
       let parse_date s =

     

       63
       -
         try

     

       64
       -
           let year = int_of_string (String.sub s 0 4) in

     

       65
       -
           let month = int_of_string (String.sub s 5 2) in

     

       66
       -
           let day = int_of_string (String.sub s 8 2) in

     

       67
       -
       

     

       68
       -
           match Ptime.of_date_time ((year, month, day), ((0, 0, 0), 0)) with

     

       69
       -
           | Some t -> t

     

       70
       -
           | None -> failwith "Invalid date"

     

       71
       -
         with _ ->

     

       72
       -
           failwith (Printf.sprintf "Invalid date format: %s (expected YYYY-MM-DD)" s)

     

       73
       -
       

     

       74
       -
       let load_event_from_file ~fs event_file =

     

       75
       -
         let file = Eio.Path.(fs / test_dir / event_file) in

     

       76
       -
         let _, file_name = Option.get @@ Eio.Path.split file in

     

       77
       -
         let content = Eio.Path.load file in

     

       78
       -
         match Icalendar.parse content with

     

       79
       -
         | Error err -> failwith (Printf.sprintf "Error parsing calendar: %s" err)

     

       80
       -
         | Ok (_, components) -> (

     

       81
       -
             match

     

       82
       -
               (* load a single event *)

     

       83
       -
               List.find_map (function `Event e -> Some e | _ -> None) components

     

       84
       -
             with

     

       85
       -
             | None -> failwith "No event found in file"

     

       86
       -
             | Some ical_event ->

     

       87
       -
                 Event.of_icalendar (Collection.Col "example") ~file_name ical_event)

     

       88
       -
       

     

       89
       -
       (* Format RRULE for display *)

     

       90
       -
       let format_rrule_str rule =

     

       91
       -
         let freq, until_count, interval, _ = rule in

     

       92
       -
         let freq_str =

     

       93
       -
           match freq with

     

       94
       -
           | `Daily -> "DAILY"

     

       95
       -
           | `Weekly -> "WEEKLY"

     

       96
       -
           | `Monthly -> "MONTHLY"

     

       97
       -
           | `Yearly -> "YEARLY"

     

       98
       -
           | _ -> "OTHER"

     

       99
       -
         in

     

       100
       -
         let count_until_str =

     

       101
       -
           match until_count with

     

       102
       -
           | Some (`Count n) -> Printf.sprintf "COUNT=%d" n

     

       103
       -
           | Some (`Until _) -> "UNTIL=..."

     

       104
       -
           | None -> ""

     

       105
       -
         in

     

       106
       -
         let interval_str =

     

       107
       -
           match interval with Some n -> Printf.sprintf "INTERVAL=%d" n | None -> ""

     

       108
       -
         in

     

       109
       -
         let parts =

     

       110
       -
           List.filter (fun s -> s <> "") [ freq_str; count_until_str; interval_str ]

     

       111
       -
         in

     

       112
       -
         "RRULE:" ^ String.concat ";" parts

     

       113
       -
       

     

       114
       -
       (* Common recurrence test logic *)

     

       115
       -
       let test_recurrence_expansion ~fs event_file start_str end_str expected_count =

     

       116
       -
         let event = load_event_from_file ~fs event_file in

     

       117
       -
         let start_date = parse_date start_str in

     

       118
       -
         let end_date = parse_date end_str in

     

       119
       -
         let instances =

     

       120
       -
           Recur.expand_event event ~from:(Some start_date) ~to_:end_date

     

       121
       -
         in

     

       122
       -
         (* Format readable info for test failure messages *)

     

       123
       -
         let rrule_str =

     

       124
       -
           match Event.get_recurrence event with

     

       125
       -
           | Some rule -> format_rrule_str rule

     

       126
       -
           | None -> "No recurrence rule"

     

       127
       -
         in

     

       128
       -
         let summary = Option.get @@ Event.get_summary event in

     

       129
       -
         let msg =

     

       130
       -
           Printf.sprintf

     

       131
       -
             "Expected %d instances for '%s' (%s) between %s and %s, but got %d"

     

       132
       -
             expected_count summary rrule_str start_str end_str (List.length instances)

     

       133
       -
         in

     

       134
       -
         Alcotest.(check int) msg expected_count (List.length instances);

     

       135
       -
         instances

     

       136
       -
       

     

       137
       -
       (* Helper to verify instances are properly spaced *)

     

       138
       -
       let verify_instance_spacing instances expected_interval =

     

       139
       -
         if List.length instances < 2 then

     

       140
       -
           Alcotest.(check bool) "Should have at least 2 unique instances" true false

     

       141
       -
         else

     

       142
       -
           let errors = ref [] in

     

       143
       -
           ignore

     

       144
       -
             (List.fold_left

     

       145
       -
                (fun prev curr ->

     

       146
       -
                  let span = Ptime.diff curr.Recur.start prev.Recur.start in

     

       147
       -
                  let days_diff =

     

       148
       -
                    Ptime.Span.to_float_s span /. float_of_int day_seconds

     

       149
       -
                    |> Float.round |> int_of_float

     

       150
       -
                  in

     

       151
       -
                  if days_diff <> expected_interval then

     

       152
       -
                    errors := (prev, curr, days_diff) :: !errors;

     

       153
       -
                  curr)

     

       154
       -
                (List.hd instances) (List.tl instances));

     

       155
       -
           match !errors with

     

       156
       -
           | [] -> ()

     

       157
       -
           | (prev, curr, actual) :: _ ->

     

       158
       -
               let msg =

     

       159
       -
                 Printf.sprintf

     

       160
       -
                   "Expected interval of %d days, but found %d days between %s and %s"

     

       161
       -
                   expected_interval actual

     

       162
       -
                   (Ptime.to_rfc3339 ~space:true prev.Recur.start)

     

       163
       -
                   (Ptime.to_rfc3339 ~space:true curr.Recur.start)

     

       164
       -
               in

     

       165
       -
               if actual = 0 then

     

       166
       -
                 (* Ignore zero interval errors for now - this means we have duplicates *)

     

       167
       -
                 ()

     

       168
       -
               else Alcotest.(check int) msg expected_interval actual

     

       169
       -
       

     

       170
       -
       let test_daily ~fs () =

     

       171
       -
         let instances =

     

       172
       -
           test_recurrence_expansion ~fs "1_daily.ics" "2025-03-27" "2025-04-10" 14

     

       173
       -
         in

     

       174
       -
         verify_instance_spacing instances 1

     

       175
       -
       

     

       176
       -
       let test_weekly ~fs () =

     

       177
       -
         let instances =

     

       178
       -
           test_recurrence_expansion ~fs "2_weekly.ics" "2025-03-27" "2025-06-27" 14

     

       179
       -
         in

     

       180
       -
         verify_instance_spacing instances 7

     

       181
       -
       

     

       182
       -
       let test_monthly ~fs () =

     

       183
       -
         let instances =

     

       184
       -
           test_recurrence_expansion ~fs "3_monthly.ics" "2025-01-01" "2025-12-31" 8

     

       185
       -
         in

     

       186
       -
         (* Just verify the results without checking the interval, since months have different lengths *)

     

       187
       -
         let first_instance = List.hd instances in

     

       188
       -
         let (_, _, first_day), _ = Ptime.to_date_time first_instance.Recur.start in

     

       189
       -
         (* Check that they all fall on the same day of the month *)

     

       190
       -
         let all_same_day =

     

       191
       -
           List.for_all

     

       192
       -
             (fun instance ->

     

       193
       -
               let (_, _, day), _ = Ptime.to_date_time instance.Recur.start in

     

       194
       -
               day = first_day)

     

       195
       -
             instances

     

       196
       -
         in

     

       197
       -
         Alcotest.(check bool)

     

       198
       -
           (Printf.sprintf "All instances should be on day %d of the month" first_day)

     

       199
       -
           true all_same_day

     

       200
       -
       

     

       201
       -
       let test_yearly ~fs () =

     

       202
       -
         let instances =

     

       203
       -
           test_recurrence_expansion ~fs "4_yearly.ics" "2025-01-01" "2035-12-31" 11

     

       204
       -
         in

     

       205
       -
         (* Verify instances are one year apart by checking the date *)

     

       206
       -
         let all_same_month_day =

     

       207
       -
           if List.length instances < 2 then true

     

       208
       -
           else

     

       209
       -
             let first = List.hd instances in

     

       210
       -
             let (_, first_month, first_day), _ =

     

       211
       -
               Ptime.to_date_time first.Recur.start

     

       212
       -
             in

     

       213
       -
             List.for_all

     

       214
       -
               (fun instance ->

     

       215
       -
                 let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       216
       -
                 month = first_month && day = first_day)

     

       217
       -
               instances

     

       218
       -
         in

     

       219
       -
         Alcotest.(check bool)

     

       220
       -
           "All instances should be on the same day/month" true all_same_month_day

     

       221
       -
       

     

       222
       -
       let test_every_2_days ~fs () =

     

       223
       -
         let instances =

     

       224
       -
           test_recurrence_expansion ~fs "5_every_2_days.ics" "2025-05-01" "2025-05-31"

     

       225
       -
             15

     

       226
       -
         in

     

       227
       -
         verify_instance_spacing instances 2

     

       228
       -
       

     

       229
       -
       let test_every_3_weeks ~fs () =

     

       230
       -
         let instances =

     

       231
       -
           test_recurrence_expansion ~fs "6_every_3_weeks.ics" "2025-05-01"

     

       232
       -
             "2025-08-31" 6

     

       233
       -
         in

     

       234
       -
         verify_instance_spacing instances 21 (* 3 weeks = 21 days *)

     

       235
       -
       

     

       236
       -
       let test_bimonthly ~fs () =

     

       237
       -
         let instances =

     

       238
       -
           test_recurrence_expansion ~fs "7_bimonthly.ics" "2025-05-01" "2026-05-31" 7

     

       239
       -
         in

     

       240
       -
         (* Verify all instances are on the same day of month *)

     

       241
       -
         let first_instance = List.hd instances in

     

       242
       -
         let (_, _, first_day), _ = Ptime.to_date_time first_instance.Recur.start in

     

       243
       -
         let all_same_day =

     

       244
       -
           List.for_all

     

       245
       -
             (fun instance ->

     

       246
       -
               let (_, _, day), _ = Ptime.to_date_time instance.Recur.start in

     

       247
       -
               day = first_day)

     

       248
       -
             instances

     

       249
       -
         in

     

       250
       -
         Alcotest.(check bool)

     

       251
       -
           (Printf.sprintf "All instances should be on day %d of the month" first_day)

     

       252
       -
           true all_same_day

     

       253
       -
       

     

       254
       -
       let test_biennial ~fs () =

     

       255
       -
         let instances =

     

       256
       -
           test_recurrence_expansion ~fs "8_biennial.ics" "2025-01-01" "2035-12-31" 6

     

       257
       -
         in

     

       258
       -
         (* Verify all instances are on the same month and day, every two years *)

     

       259
       -
         let first_instance = List.hd instances in

     

       260
       -
         let (first_year, first_month, first_day), _ =

     

       261
       -
           Ptime.to_date_time first_instance.Recur.start

     

       262
       -
         in

     

       263
       -
         let all_same_date_alternate_years =

     

       264
       -
           List.for_all

     

       265
       -
             (fun instance ->

     

       266
       -
               let (year, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       267
       -
               month = first_month && day = first_day && (year - first_year) mod 2 = 0)

     

       268
       -
             instances

     

       269
       -
         in

     

       270
       -
         Alcotest.(check bool)

     

       271
       -
           "All instances should be on same day/month every two years" true

     

       272
       -
           all_same_date_alternate_years

     

       273
       -
       

     

       274
       -
       let test_daily_count5 ~fs () =

     

       275
       -
         let instances =

     

       276
       -
           test_recurrence_expansion ~fs "9_daily_count5.ics" "2025-05-01" "2025-05-31"

     

       277
       -
             5

     

       278
       -
         in

     

       279
       -
         Alcotest.(check int)

     

       280
       -
           "Should have exactly 5 instances" 5 (List.length instances);

     

       281
       -
         verify_instance_spacing instances 1

     

       282
       -
       

     

       283
       -
       let test_weekly_count10 ~fs () =

     

       284
       -
         let instances =

     

       285
       -
           test_recurrence_expansion ~fs "10_weekly_count10.ics" "2025-03-17"

     

       286
       -
             "2025-06-30" 10

     

       287
       -
         in

     

       288
       -
         verify_instance_spacing instances 7

     

       289
       -
       

     

       290
       -
       let test_daily_until ~fs () =

     

       291
       -
         let instances =

     

       292
       -
           test_recurrence_expansion ~fs "11_daily_until.ics" "2025-05-01" "2025-05-31"

     

       293
       -
             14

     

       294
       -
         in

     

       295
       -
         (* Verify instances only occur until May 15 *)

     

       296
       -
         let last_instance =

     

       297
       -
           List.fold_left

     

       298
       -
             (fun latest curr ->

     

       299
       -
               if Ptime.compare curr.Recur.start latest.Recur.start > 0 then curr

     

       300
       -
               else latest)

     

       301
       -
             (List.hd instances) instances

     

       302
       -
         in

     

       303
       -
         let (_, month, day), _ = Ptime.to_date_time last_instance.Recur.start in

     

       304
       -
         Alcotest.(check int) "Last instance should be in May" 5 month;

     

       305
       -
         Alcotest.(check bool)

     

       306
       -
           "Last instance should be on or before May 15" true (day <= 15);

     

       307
       -
         verify_instance_spacing instances 1

     

       308
       -
       

     

       309
       -
       let test_weekly_until ~fs () =

     

       310
       -
         let instances =

     

       311
       -
           test_recurrence_expansion ~fs "12_weekly_until.ics" "2025-05-01"

     

       312
       -
             "2025-07-31" 9

     

       313
       -
         in

     

       314
       -
         (* Verify instances only occur until June 30 *)

     

       315
       -
         let last_instance =

     

       316
       -
           List.fold_left

     

       317
       -
             (fun latest curr ->

     

       318
       -
               if Ptime.compare curr.Recur.start latest.Recur.start > 0 then curr

     

       319
       -
               else latest)

     

       320
       -
             (List.hd instances) instances

     

       321
       -
         in

     

       322
       -
         let (_, month, day), _ = Ptime.to_date_time last_instance.Recur.start in

     

       323
       -
         Alcotest.(check int) "Last instance should be in June" 6 month;

     

       324
       -
         Alcotest.(check bool)

     

       325
       -
           "Last instance should be on or before June 30" true (day <= 30);

     

       326
       -
         verify_instance_spacing instances 7

     

       327
       -
       

     

       328
       -
       let test_weekly_monday_wednesday ~fs () =

     

       329
       -
         let instances =

     

       330
       -
           test_recurrence_expansion ~fs "13_weekly_monday_wednesday.ics" "2025-03-24"

     

       331
       -
             "2025-04-30" 11

     

       332
       -
         in

     

       333
       -
         let check_day_of_week instance day_list =

     

       334
       -
           let date = instance.Recur.start in

     

       335
       -
           let weekday =

     

       336
       -
             match Ptime.weekday ~tz_offset_s:0 date with

     

       337
       -
             | `Mon -> 1

     

       338
       -
             | `Tue -> 2

     

       339
       -
             | `Wed -> 3

     

       340
       -
             | `Thu -> 4

     

       341
       -
             | `Fri -> 5

     

       342
       -
             | `Sat -> 6

     

       343
       -
             | `Sun -> 0

     

       344
       -
           in

     

       345
       -
           List.mem weekday day_list

     

       346
       -
         in

     

       347
       -
         let all_on_mon_wed =

     

       348
       -
           List.for_all

     

       349
       -
             (fun instance ->

     

       350
       -
               check_day_of_week instance [ 1; 3 ] (* Monday = 1, Wednesday = 3 *))

     

       351
       -
             instances

     

       352
       -
         in

     

       353
       -
         Alcotest.(check bool)

     

       354
       -
           "All instances should be on Monday or Wednesday" true all_on_mon_wed

     

       355
       -
       

     

       356
       -
       let test_weekly_weekends ~fs () =

     

       357
       -
         let instances =

     

       358
       -
           test_recurrence_expansion ~fs "14_weekly_weekends.ics" "2025-05-01"

     

       359
       -
             "2025-06-30" 18

     

       360
       -
         in

     

       361
       -
         let check_day_of_week instance day_list =

     

       362
       -
           let date = instance.Recur.start in

     

       363
       -
           let weekday =

     

       364
       -
             match Ptime.weekday ~tz_offset_s:0 date with

     

       365
       -
             | `Mon -> 1

     

       366
       -
             | `Tue -> 2

     

       367
       -
             | `Wed -> 3

     

       368
       -
             | `Thu -> 4

     

       369
       -
             | `Fri -> 5

     

       370
       -
             | `Sat -> 6

     

       371
       -
             | `Sun -> 0

     

       372
       -
           in

     

       373
       -
           List.mem weekday day_list

     

       374
       -
         in

     

       375
       -
         let all_on_weekends =

     

       376
       -
           List.for_all

     

       377
       -
             (fun instance ->

     

       378
       -
               check_day_of_week instance [ 6; 0 ] (* Saturday = 6, Sunday = 0 *))

     

       379
       -
             instances

     

       380
       -
         in

     

       381
       -
         Alcotest.(check bool)

     

       382
       -
           "All instances should be on Saturday or Sunday" true all_on_weekends

     

       383
       -
       

     

       384
       -
       let test_monthly_specific_day ~fs () =

     

       385
       -
         let instances =

     

       386
       -
           test_recurrence_expansion ~fs "15_monthly_specific_day.ics" "2025-01-01"

     

       387
       -
             "2025-12-31" 8

     

       388
       -
         in

     

       389
       -
         (* Verify all instances are on the same day of month *)

     

       390
       -
         let first_instance = List.hd instances in

     

       391
       -
         let (_, _, first_day), _ = Ptime.to_date_time first_instance.Recur.start in

     

       392
       -
         let all_same_day =

     

       393
       -
           List.for_all

     

       394
       -
             (fun instance ->

     

       395
       -
               let (_, _, day), _ = Ptime.to_date_time instance.Recur.start in

     

       396
       -
               day = first_day)

     

       397
       -
             instances

     

       398
       -
         in

     

       399
       -
         Alcotest.(check bool)

     

       400
       -
           (Printf.sprintf "All instances should be on day %d of the month" first_day)

     

       401
       -
           true all_same_day

     

       402
       -
       

     

       403
       -
       let test_monthly_second_monday ~fs () =

     

       404
       -
         let instances =

     

       405
       -
           test_recurrence_expansion ~fs "16_monthly_second_monday.ics" "2025-05-01"

     

       406
       -
             "2026-04-30" 11

     

       407
       -
         in

     

       408
       -
         let check_day_of_week instance =

     

       409
       -
           let date = instance.Recur.start in

     

       410
       -
           let weekday =

     

       411
       -
             match Ptime.weekday ~tz_offset_s:0 date with `Mon -> true | _ -> false

     

       412
       -
           in

     

       413
       -
           let (_, _, day), _ = Ptime.to_date_time date in

     

       414
       -
           weekday && day >= 8 && day <= 14 (* Second Monday is between 8th and 14th *)

     

       415
       -
         in

     

       416
       -
         let all_second_mondays = List.for_all check_day_of_week instances in

     

       417
       -
         Alcotest.(check bool)

     

       418
       -
           "All instances should be on the second Monday of each month" true

     

       419
       -
           all_second_mondays

     

       420
       -
       

     

       421
       -
       let test_monthly_last_day ~fs () =

     

       422
       -
         let instances =

     

       423
       -
           test_recurrence_expansion ~fs "17_monthly_last_day.ics" "2025-05-01"

     

       424
       -
             "2026-04-30" 11

     

       425
       -
         in

     

       426
       -
         let is_last_day_of_month instance =

     

       427
       -
           let date = instance.Recur.start in

     

       428
       -
           let (year, month, day), _ = Ptime.to_date_time date in

     

       429
       -
           let last_day =

     

       430
       -
             match month with

     

       431
       -
             | 2 ->

     

       432
       -
                 if (year mod 4 = 0 && year mod 100 <> 0) || year mod 400 = 0 then 29

     

       433
       -
                 else 28

     

       434
       -
             | 4 | 6 | 9 | 11 -> 30

     

       435
       -
             | _ -> 31

     

       436
       -
           in

     

       437
       -
           day = last_day

     

       438
       -
         in

     

       439
       -
         let all_last_days = List.for_all is_last_day_of_month instances in

     

       440
       -
         Alcotest.(check bool)

     

       441
       -
           "All instances should be on the last day of each month" true all_last_days

     

       442
       -
       

     

       443
       -
       let test_yearly_specific_date ~fs () =

     

       444
       -
         let instances =

     

       445
       -
           test_recurrence_expansion ~fs "18_yearly_specific_date.ics" "2025-01-01"

     

       446
       -
             "2035-12-31" 11

     

       447
       -
         in

     

       448
       -
         (* Verify all instances are on the same month and day *)

     

       449
       -
         let first_instance = List.hd instances in

     

       450
       -
         let (_, first_month, first_day), _ =

     

       451
       -
           Ptime.to_date_time first_instance.Recur.start

     

       452
       -
         in

     

       453
       -
         let all_same_date =

     

       454
       -
           List.for_all

     

       455
       -
             (fun instance ->

     

       456
       -
               let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       457
       -
               month = first_month && day = first_day)

     

       458
       -
             instances

     

       459
       -
         in

     

       460
       -
         Alcotest.(check bool)

     

       461
       -
           (Printf.sprintf "All instances should be on %d/%d" first_month first_day)

     

       462
       -
           true all_same_date

     

       463
       -
       

     

       464
       -
       let test_yearly_mothers_day ~fs () =

     

       465
       -
         let instances =

     

       466
       -
           test_recurrence_expansion ~fs "19_yearly_mothers_day.ics" "2025-01-01"

     

       467
       -
             "2035-12-31" 10

     

       468
       -
         in

     

       469
       -
         let is_second_sunday_in_may instance =

     

       470
       -
           let date = instance.Recur.start in

     

       471
       -
           let (_, month, day), _ = Ptime.to_date_time date in

     

       472
       -
           let is_sunday =

     

       473
       -
             match Ptime.weekday ~tz_offset_s:0 date with `Sun -> true | _ -> false

     

       474
       -
           in

     

       475
       -
           month = 5 && is_sunday && day >= 8

     

       476
       -
           && day <= 14 (* Second Sunday is between 8th and 14th *)

     

       477
       -
         in

     

       478
       -
         let all_mothers_days = List.for_all is_second_sunday_in_may instances in

     

       479
       -
         Alcotest.(check bool)

     

       480
       -
           "All instances should be on the second Sunday in May" true all_mothers_days

     

       481
       -
       

     

       482
       -
       let test_complex_weekdays_months ~fs () =

     

       483
       -
         let instances =

     

       484
       -
           test_recurrence_expansion ~fs "20_complex_weekdays_months.ics" "2025-05-01"

     

       485
       -
             "2025-09-30" 26

     

       486
       -
         in

     

       487
       -
         let is_tue_thu_in_summer instance =

     

       488
       -
           let date = instance.Recur.start in

     

       489
       -
           let (_, month, _), _ = Ptime.to_date_time date in

     

       490
       -
           let is_tue_thu =

     

       491
       -
             match Ptime.weekday ~tz_offset_s:0 date with

     

       492
       -
             | `Tue | `Thu -> true

     

       493
       -
             | _ -> false

     

       494
       -
           in

     

       495
       -
           is_tue_thu && (month = 6 || month = 7 || month = 8)

     

       496
       -
           (* Jun, Jul, Aug *)

     

       497
       -
         in

     

       498
       -
         let all_valid = List.for_all is_tue_thu_in_summer instances in

     

       499
       -
         Alcotest.(check bool)

     

       500
       -
           "All instances should be on Tuesday/Thursday in summer months" true

     

       501
       -
           all_valid

     

       502
       -
       

     

       503
       -
       let test_complex_multiple_monthdays ~fs () =

     

       504
       -
         let instances =

     

       505
       -
           test_recurrence_expansion ~fs "21_complex_multiple_monthdays.ics"

     

       506
       -
             "2025-05-01" "2026-05-31" 38

     

       507
       -
         in

     

       508
       -
         (* Verify instances fall on the specified days (1st, 15th, or last day of month) *)

     

       509
       -
         let valid_day =

     

       510
       -
          fun day month ->

     

       511
       -
           day = 1 || day = 15

     

       512
       -
           || (month = 1 && day = 31)

     

       513
       -
           (* not a leap year *)

     

       514
       -
           || (month = 2 && day = 28)

     

       515
       -
           || (month = 3 && day = 31)

     

       516
       -
           || (month = 4 && day = 30)

     

       517
       -
           || (month = 5 && day = 31)

     

       518
       -
           || (month = 6 && day = 30)

     

       519
       -
           || (month = 7 && day = 31)

     

       520
       -
           || (month = 8 && day = 31)

     

       521
       -
           || (month = 9 && day = 30)

     

       522
       -
           || (month = 10 && day = 31)

     

       523
       -
           || (month = 11 && day = 30)

     

       524
       -
           || (month = 12 && day = 31)

     

       525
       -
         in

     

       526
       -
         let all_valid_days =

     

       527
       -
           List.for_all

     

       528
       -
             (fun instance ->

     

       529
       -
               let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       530
       -
               valid_day day month)

     

       531
       -
             instances

     

       532
       -
         in

     

       533
       -
         Alcotest.(check bool)

     

       534
       -
           "All instances should be on 1st, 15th, or last day of month" true

     

       535
       -
           all_valid_days

     

       536
       -
       

     

       537
       -
       let test_with_exdate ~fs () =

     

       538
       -
         let instances =

     

       539
       -
           test_recurrence_expansion ~fs "22_with_exdate.ics" "2025-05-01" "2025-06-30"

     

       540
       -
             9

     

       541
       -
         in

     

       542
       -
         (* Verify that excluded dates (May 15 and May 29) are not in the instances *)

     

       543
       -
         let excluded_dates = [ parse_date "2025-05-15"; parse_date "2025-05-29" ] in

     

       544
       -
         let no_excluded_dates =

     

       545
       -
           List.for_all

     

       546
       -
             (fun instance ->

     

       547
       -
               let check_not_excluded excluded =

     

       548
       -
                 Ptime.compare instance.Recur.start excluded <> 0

     

       549
       -
               in

     

       550
       -
               List.for_all check_not_excluded excluded_dates)

     

       551
       -
             instances

     

       552
       -
         in

     

       553
       -
         Alcotest.(check bool)

     

       554
       -
           "No instances should be on excluded dates" true no_excluded_dates;

     

       555
       -
         (* Weekly recurrence should have 9 instances in this period *)

     

       556
       -
         Alcotest.(check int) "Should have 9 instances" 9 (List.length instances)

     

       557
       -
       

     

       558
       -
       let test_dst_transition ~fs () =

     

       559
       -
         (* This event occurs from 2025-10-27 to 2025-11-17 *)

     

       560
       -
         let instances =

     

       561
       -
           test_recurrence_expansion ~fs "23_dst_transition.ics" "2025-10-01"

     

       562
       -
             "2025-11-30" 4

     

       563
       -
         in

     

       564
       -
         Alcotest.(check int)

     

       565
       -
           "Should have 4 instances across DST transition" 4 (List.length instances);

     

       566
       -
         (* Check each consecutive pair of dates *)

     

       567
       -
         ignore

     

       568
       -
           (List.fold_left

     

       569
       -
              (fun prev curr ->

     

       570
       -
                let span = Ptime.diff curr.Recur.start prev.Recur.start in

     

       571
       -
                let days_diff =

     

       572
       -
                  Ptime.Span.to_float_s span /. float_of_int day_seconds

     

       573
       -
                  |> Float.round |> int_of_float

     

       574
       -
                in

     

       575
       -
                Alcotest.(check int)

     

       576
       -
                  (Printf.sprintf "Days diff should be 7 days")

     

       577
       -
                  7 days_diff;

     

       578
       -
                curr)

     

       579
       -
              (List.hd instances) (List.tl instances))

     

       580
       -
       

     

       581
       -
       let test_long_interval ~fs () =

     

       582
       -
         let instances =

     

       583
       -
           test_recurrence_expansion ~fs "24_long_interval.ics" "2025-05-01"

     

       584
       -
             "2026-05-31" 4

     

       585
       -
         in

     

       586
       -
         verify_instance_spacing instances 100

     

       587
       -
       

     

       588
       -
       let test_leap_day ~fs () =

     

       589
       -
         let instances =

     

       590
       -
           test_recurrence_expansion ~fs "25_leap_day.ics" "2028-01-01" "2036-12-31" 3

     

       591
       -
         in

     

       592
       -
         Alcotest.(check int)

     

       593
       -
           "Should have 3 leap day instances" 3 (List.length instances);

     

       594
       -
         let all_leap_days =

     

       595
       -
           List.for_all

     

       596
       -
             (fun instance ->

     

       597
       -
               let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       598
       -
               month = 2 && day = 29)

     

       599
       -
             instances

     

       600
       -
         in

     

       601
       -
         Alcotest.(check bool)

     

       602
       -
           "All instances should be on February 29" true all_leap_days;

     

       603
       -
         let years =

     

       604
       -
           List.map

     

       605
       -
             (fun instance ->

     

       606
       -
               let (year, _, _), _ = Ptime.to_date_time instance.Recur.start in

     

       607
       -
               year)

     

       608
       -
             instances

     

       609
       -
           |> List.sort_uniq compare

     

       610
       -
         in

     

       611
       -
         let expected_years = [ 2028; 2032; 2036 ] in

     

       612
       -
         Alcotest.(check (list int))

     

       613
       -
           "Should have instances in leap years 2028, 2032, and 2036" expected_years

     

       614
       -
           years

     

       615
       -
       

     

       616
       -
       let test_weekly_wkst ~fs () =

     

       617
       -
         let instances =

     

       618
       -
           test_recurrence_expansion ~fs "26_weekly_wkst.ics" "2025-05-01" "2025-05-31"

     

       619
       -
             4

     

       620
       -
         in

     

       621
       -
         (* Verify we get exactly 4 instances (COUNT=4) *)

     

       622
       -
         Alcotest.(check int)

     

       623
       -
           "Should have exactly 4 instances" 4 (List.length instances);

     

       624
       -
         verify_instance_spacing instances 7

     

       625
       -
       

     

       626
       -
       let test_monthly_nth_weekday ~fs () =

     

       627
       -
         let instances =

     

       628
       -
           test_recurrence_expansion ~fs "27_monthly_nth_weekday.ics" "2025-05-01"

     

       629
       -
             "2026-04-30" 11

     

       630
       -
         in

     

       631
       -
         let is_third_sunday instance =

     

       632
       -
           let date = instance.Recur.start in

     

       633
       -
           let is_sunday =

     

       634
       -
             match Ptime.weekday ~tz_offset_s:0 date with `Sun -> true | _ -> false

     

       635
       -
           in

     

       636
       -
           let (_, _, day), _ = Ptime.to_date_time date in

     

       637
       -
           is_sunday && day >= 15

     

       638
       -
           && day <= 21 (* Third Sunday is between 15th and 21st *)

     

       639
       -
         in

     

       640
       -
         let all_third_sundays = List.for_all is_third_sunday instances in

     

       641
       -
         Alcotest.(check bool)

     

       642
       -
           "All instances should be on the third Sunday of each month" true

     

       643
       -
           all_third_sundays

     

       644
       -
       

     

       645
       -
       let test_yearly_historical ~fs () =

     

       646
       -
         let instances =

     

       647
       -
           test_recurrence_expansion ~fs "28_yearly_historical.ics" "2000-01-01"

     

       648
       -
             "2011-01-01" 11

     

       649
       -
         in

     

       650
       -
         (* Verify instances are yearly and end by 2010-12-31 *)

     

       651
       -
         let all_before_2011 =

     

       652
       -
           List.for_all

     

       653
       -
             (fun instance ->

     

       654
       -
               let (year, _, _), _ = Ptime.to_date_time instance.Recur.start in

     

       655
       -
               year <= 2010)

     

       656
       -
             instances

     

       657
       -
         in

     

       658
       -
         Alcotest.(check bool)

     

       659
       -
           "All instances should be before 2011" true all_before_2011;

     

       660
       -
         ()

     

       661
       -
       

     

       662
       -
       let test_monthly_bymonth ~fs () =

     

       663
       -
         let instances =

     

       664
       -
           test_recurrence_expansion ~fs "29_monthly_bymonth.ics" "2025-01-01"

     

       665
       -
             "2026-12-31" 8

     

       666
       -
         in

     

       667
       -
         let is_specified_month instance =

     

       668
       -
           let date = instance.Recur.start in

     

       669
       -
           let (_, month, _), _ = Ptime.to_date_time date in

     

       670
       -
           month = 3 || month = 6 || month = 9 || month = 12 (* Mar, Jun, Sep, Dec *)

     

       671
       -
         in

     

       672
       -
         let all_specified_months = List.for_all is_specified_month instances in

     

       673
       -
         Alcotest.(check bool)

     

       674
       -
           "All instances should be in Mar, Jun, Sep, or Dec" true all_specified_months;

     

       675
       -
         ()

     

       676
       -
       

     

       677
       -
       let test_fourth_weekday ~fs () =

     

       678
       -
         let instances =

     

       679
       -
           test_recurrence_expansion ~fs "30_fourth_weekday.ics" "2025-01-01"

     

       680
       -
             "2035-12-31" 10

     

       681
       -
         in

     

       682
       -
         let is_fourth_sunday_in_october instance =

     

       683
       -
           let date = instance.Recur.start in

     

       684
       -
           let (_, month, day), _ = Ptime.to_date_time date in

     

       685
       -
           let is_sunday =

     

       686
       -
             match Ptime.weekday ~tz_offset_s:0 date with `Sun -> true | _ -> false

     

       687
       -
           in

     

       688
       -
           month = 10 && is_sunday && day >= 22

     

       689
       -
           && day <= 28 (* Fourth Sunday is between 22nd and 28th *)

     

       690
       -
         in

     

       691
       -
         let all_fourth_sundays = List.for_all is_fourth_sunday_in_october instances in

     

       692
       -
         Alcotest.(check bool)

     

       693
       -
           "All instances should be on the fourth Sunday in October" true

     

       694
       -
           all_fourth_sundays

     

       695
       -
       

     

       696
       -
       let recur_expand_tests ~fs =

     

       697
       -
         [

     

       698
       -
           ( "recurring events in date range",

     

       699
       -
             `Quick,

     

       700
       -
             test_recurring_events_in_date_range );

     

       701
       -
           ("daily recurrence", `Quick, test_daily ~fs);

     

       702
       -
           ("weekly recurrence", `Quick, test_weekly ~fs);

     

       703
       -
           ("monthly recurrence", `Quick, test_monthly ~fs);

     

       704
       -
           ("yearly recurrence", `Quick, test_yearly ~fs);

     

       705
       -
           ("every 2 days", `Quick, test_every_2_days ~fs);

     

       706
       -
           ("every 3 weeks", `Quick, test_every_3_weeks ~fs);

     

       707
       -
           ("bimonthly", `Quick, test_bimonthly ~fs);

     

       708
       -
           ("biennial", `Quick, test_biennial ~fs);

     

       709
       -
           ("daily with count=5", `Quick, test_daily_count5 ~fs);

     

       710
       -
           ("weekly with count=10", `Quick, test_weekly_count10 ~fs);

     

       711
       -
           ("daily until", `Quick, test_daily_until ~fs);

     

       712
       -
           ("weekly until", `Quick, test_weekly_until ~fs);

     

       713
       -
           ("weekly on Monday/Wednesday", `Quick, test_weekly_monday_wednesday ~fs);

     

       714
       -
           ("weekly on weekends", `Quick, test_weekly_weekends ~fs);

     

       715
       -
           ("monthly on specific day", `Quick, test_monthly_specific_day ~fs);

     

       716
       -
           ("monthly on second Monday", `Quick, test_monthly_second_monday ~fs);

     

       717
       -
           ("monthly on last day", `Quick, test_monthly_last_day ~fs);

     

       718
       -
           ("yearly on specific date", `Quick, test_yearly_specific_date ~fs);

     

       719
       -
           ("yearly on Mother's Day", `Quick, test_yearly_mothers_day ~fs);

     

       720
       -
           ("complex weekdays and months", `Quick, test_complex_weekdays_months ~fs);

     

       721
       -
           ("complex multiple month days", `Quick, test_complex_multiple_monthdays ~fs);

     

       722
       -
           ("with excluded dates", `Quick, test_with_exdate ~fs);

     

       723
       -
           ("DST transition handling", `Quick, test_dst_transition ~fs);

     

       724
       -
           ("long interval", `Quick, test_long_interval ~fs);

     

       725
       -
           ("leap day handling", `Quick, test_leap_day ~fs);

     

       726
       -
           ("weekly with week start", `Quick, test_weekly_wkst ~fs);

     

       727
       -
           ("monthly on nth weekday", `Quick, test_monthly_nth_weekday ~fs);

     

       728
       -
           ("yearly historical", `Quick, test_yearly_historical ~fs);

     

       729
       -
           ("monthly by month", `Quick, test_monthly_bymonth ~fs);

     

       730
       -
           ("fourth weekday", `Quick, test_fourth_weekday ~fs);

     

       731
       -
         ]

     

       732
       -
       

     

       733
       -
       let () =

     

       734
       -
         Eio_main.run @@ fun env ->

     

       735
       -
         let fs = Eio.Stdenv.fs env in

     

       736
       -
         Alcotest.run "Recur Expansion Tests"

     

       737
       -
           [ ("recur_expand", recur_expand_tests ~fs) ]

Compare changes