commit fcb62e22f6976f566a428fe0987e2ed496fc5958 · ryan.freumh.org/caledonia

.gitignore

···

       1
       +
       _build/

     

       2
       +
       _opam/

.ocamlformat

This is a binary file and will not be displayed.

+19

README.md

···

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

     

       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` and `query` commands.

     

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

     

       7
       +
       

     

       8
       +
       ## Configuration

     

       9
       +
       

     

       10
       +
       Caledonia looks for calendars in the directory specified by the `CALENDAR_DIR` environment variable or in `~/.calendars/` by default.

     

       11
       +
       

     

       12
       +
       ## Tests

     

       13
       +
       

     

       14
       +
       The project includes a test suite that can be ran with `dune runtest`.

     

       15
       +
       

     

       16
       +
       ## Thanks

     

       17
       +
       

     

       18
       +
       To [Patrick](https://patrick.sirref.org/) for suggesting the name, and all the developers of the dependencies used, especially [icalendar](https://github.com/robur-coop/icalendar) and [calendar](https://github.com/ocaml-community/calendar).

     

       19
       +

+15

TODO.org

···

       1
       +
       * DONE list/search events

     

       2
       +
       * TODO diagnose events failing to parse

     

       3
       +
       * TODO timezones and daylight saving

     

       4
       +
       * TODO add/remove events

     

       5
       +
       * TODO edit events

     

       6
       +
       will need to modify the event to ICS code to retain fields we don't use

     

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

     

       8
       +
       * TODO CalDAV syncing

     

       9
       +
       Currently, you can use [[https://github.com/pimutils/vdirsyncer][vdirsyncer]]

     

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

     

       11
       +
       * TODO support querying times as well as dates

     

       12
       +
       * TODO custom date/time formatting

     

       13
       +
       * TODO support querying regex

     

       14
       +
       * TODO server mode

     

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

+17

bin/dune

···

       1
       +
       (executable

     

       2
       +
        (name main)

     

       3
       +
        (public_name caled)

     

       4
       +
        (package caledonia)

     

       5
       +
        (libraries

     

       6
       +
         caledonia_lib

     

       7
       +
         cmdliner

     

       8
       +
         fmt

     

       9
       +
         logs

     

       10
       +
         logs.fmt

     

       11
       +
         logs.cli

     

       12
       +
         re

     

       13
       +
         ptime

     

       14
       +
         ptime.clock.os

     

       15
       +
         eio

     

       16
       +
         eio_main)

     

       17
       +
        (modules main list_cmd search_cmd query_args))

+91

bin/list_cmd.ml

···

       1
       +
       open Cmdliner

     

       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 Query.convert_relative_date_formats ~today ~tomorrow ~week ~month with

     

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

     

       11
       +
           | None -> (

     

       12
       +
               match (from, to_) with

     

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

     

       14
       +
               | Some f, None ->

     

       15
       +
                   let one_month_later = Query.add_months f 1 in

     

       16
       +
                   (Some f, one_month_later)

     

       17
       +
               | None, Some t ->

     

       18
       +
                   let today_date = !Query.get_today () in

     

       19
       +
                   (Some today_date, Query.to_end_of_day t)

     

       20
       +
               | None, None ->

     

       21
       +
                   let today_date = !Query.get_today () in

     

       22
       +
                   let one_month_later = Query.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 [ Calendar_dir.Collection collection_id ])

     

       29
       +
           | None -> None

     

       30
       +
         in

     

       31
       +
         let* results =

     

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

     

       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 =

     

       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;

     

       46
       +
               1

     

       47
       +
           | Ok () -> 0

     

       48
       +
         in

     

       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)

     

       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.";

     

       62
       +
             `S Manpage.s_options;

     

       63
       +
             `S "DATE FORMATS";

     

       64
       +
           ]

     

       65
       +
           @ date_format_manpage_entries

     

       66
       +
           @ [

     

       67
       +
               `S "EXAMPLES";

     

       68
       +
               `P "List all events for today:";

     

       69
       +
               `P "  caled list --today";

     

       70
       +
               `P "List all events for tomorrow:";

     

       71
       +
               `P "  caled list --tomorrow";

     

       72
       +
               `P "List all events for the current week:";

     

       73
       +
               `P "  caled list --week";

     

       74
       +
               `P "List all events for the current month:";

     

       75
       +
               `P "  caled list --month";

     

       76
       +
               `P "List events within a specific date range:";

     

       77
       +
               `P "  caled list --from 2025-03-27 --to 2025-04-01";

     

       78
       +
               `P "List events from a specific calendar:";

     

       79
       +
               `P "  caled list --calendar work";

     

       80
       +
               `P "List events in JSON format:";

     

       81
       +
               `P "  caled list --format json";

     

       82
       +
               `P "Limit the number of events shown:";

     

       83
       +
               `P "  caled list --count 5";

     

       84
       +
             ]

     

       85
       +
         in

     

       86
       +
         let exit_info =

     

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

     

       88
       +
         in

     

       89
       +
       

     

       90
       +
         let info = Cmd.info "list" ~doc ~man ~exits:exit_info in

     

       91
       +
         Cmd.v info term

+45

bin/main.ml

···

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

     

       2
       +
       

     

       3
       +
       open Cmdliner

     

       4
       +
       

     

       5
       +
       let list_cmd = List_cmd.cmd

     

       6
       +
       let search_cmd = Search_cmd.cmd

     

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

     

       8
       +
       let version = "%%VERSION%%"

     

       9
       +
       

     

       10
       +
       let main env =

     

       11
       +
         let exit_info =

     

       12
       +
           [

     

       13
       +
             Cmd.Exit.info ~doc:"on success." 0;

     

       14
       +
             Cmd.Exit.info

     

       15
       +
               ~doc:

     

       16
       +
                 "on error (including invalid date format, file access issues, or \

     

       17
       +
                  other errors)."

     

       18
       +
               1;

     

       19
       +
           ]

     

       20
       +
         in

     

       21
       +
         let info = Cmd.info "caled" ~version ~doc ~exits:exit_info in

     

       22
       +
         let default =

     

       23
       +
           Term.(ret (const (fun () -> `Help (`Pager, None)) $ const ()))

     

       24
       +
         in

     

       25
       +
         let calendar_dir_path =

     

       26
       +
           match Sys.getenv_opt "CALENDAR_DIR" with

     

       27
       +
           | Some dir -> dir

     

       28
       +
           | None -> Filename.concat (Sys.getenv "HOME") ".calendar"

     

       29
       +
         in

     

       30
       +
         let fs = Eio.Stdenv.fs env in

     

       31
       +
         match Caledonia_lib.Calendar_dir.create ~fs calendar_dir_path with

     

       32
       +
         | Error (`Msg e) ->

     

       33
       +
             Printf.eprintf "%s" e;

     

       34
       +
             1

     

       35
       +
         | Ok calendar_dir -> (

     

       36
       +
             match

     

       37
       +
               Cmd.eval_value

     

       38
       +
                 (Cmd.group info ~default

     

       39
       +
                    [ list_cmd ~fs calendar_dir; search_cmd ~fs calendar_dir ])

     

       40
       +
             with

     

       41
       +
             | Ok (`Ok n) -> n

     

       42
       +
             | Ok _ -> 0

     

       43
       +
             | Error _ -> 1)

     

       44
       +
       

     

       45
       +
       let () = Eio_main.run @@ fun env -> exit (main env)

+92

bin/query_args.ml

···

       1
       +
       open Cmdliner

     

       2
       +
       open Caledonia_lib

     

       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 =

     

       12
       +
           try Ok (Query.parse_date_expression s `From)

     

       13
       +
           with Failure msg -> Error (`Msg msg)

     

       14
       +
         in

     

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

     

       16
       +
       

     

       17
       +
       let to_arg =

     

       18
       +
         let doc =

     

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

     

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

     

       21
       +
         in

     

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

     

       23
       +
         let parse_date s =

     

       24
       +
           try Ok (Query.parse_date_expression s `To)

     

       25
       +
           with Failure msg -> Error (`Msg msg)

     

       26
       +
         in

     

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

     

       28
       +
       

     

       29
       +
       let calendar_arg =

     

       30
       +
         let doc = "Calendar to filter by" in

     

       31
       +
         Arg.(

     

       32
       +
           value

     

       33
       +
           & opt (some string) None

     

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

     

       35
       +
       

     

       36
       +
       let format_enum =

     

       37
       +
         [

     

       38
       +
           ("text", `Text);

     

       39
       +
           ("json", `Json);

     

       40
       +
           ("csv", `Csv);

     

       41
       +
           ("ics", `Ics);

     

       42
       +
           ("table", `Table);

     

       43
       +
           ("sexp", `Sexp);

     

       44
       +
         ]

     

       45
       +
       

     

       46
       +
       let format_arg =

     

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

     

       48
       +
         Arg.(

     

       49
       +
           value

     

       50
       +
           & opt (enum format_enum) `Text

     

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

     

       52
       +
       

     

       53
       +
       let count_arg =

     

       54
       +
         let doc = "Maximum number of events to display" in

     

       55
       +
         Arg.(value & opt (some int) None & info [ "count"; "n" ] ~docv:"COUNT" ~doc)

     

       56
       +
       

     

       57
       +
       let today_arg =

     

       58
       +
         let doc = "Show events for today only" in

     

       59
       +
         Arg.(value & flag & info [ "today"; "d" ] ~doc)

     

       60
       +
       

     

       61
       +
       let tomorrow_arg =

     

       62
       +
         let doc = "Show events for tomorrow only" in

     

       63
       +
         Arg.(value & flag & info [ "tomorrow" ] ~doc)

     

       64
       +
       

     

       65
       +
       let week_arg =

     

       66
       +
         let doc = "Show events for the current week" in

     

       67
       +
         Arg.(value & flag & info [ "week"; "w" ] ~doc)

     

       68
       +
       

     

       69
       +
       let month_arg =

     

       70
       +
         let doc = "Show events for the current month" in

     

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

     

       72
       +
       

     

       73
       +
       let date_format_manpage_entries =

     

       74
       +
         [

     

       75
       +
           `P "Date format flags:";

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       92
       +
         ]

+153

bin/search_cmd.ml

···

       1
       +
       open Cmdliner

     

       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 Query.convert_relative_date_formats ~today ~tomorrow ~week ~month with

     

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

     

       13
       +
           | None -> (

     

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

     

       15
       +
               match (from, to_) with

     

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

     

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

     

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

     

       19
       +
               | None, None -> (None, Query.to_end_of_day max_date))

     

       20
       +
         in

     

       21
       +
         (match calendar with

     

       22
       +
         | Some collection_id ->

     

       23
       +
             filters :=

     

       24
       +
               Query.in_collections [ Calendar_dir.Collection collection_id ]

     

       25
       +
               :: !filters

     

       26
       +
         | None -> ());

     

       27
       +
         (match query_text with

     

       28
       +
         | Some text ->

     

       29
       +
             if summary then filters := Query.summary_contains text :: !filters;

     

       30
       +
             if description then filters := Query.description_contains text :: !filters;

     

       31
       +
             if location then filters := Query.location_contains text :: !filters;

     

       32
       +
             if not (summary || description || location) then

     

       33
       +
               filters :=

     

       34
       +
                 Query.or_filter

     

       35
       +
                   [

     

       36
       +
                     Query.summary_contains text;

     

       37
       +
                     Query.description_contains text;

     

       38
       +
                     Query.location_contains text;

     

       39
       +
                   ]

     

       40
       +
                 :: !filters

     

       41
       +
         | None -> ());

     

       42
       +
         if recurring then filters := Query.recurring_only () :: !filters;

     

       43
       +
         if non_recurring then filters := Query.non_recurring_only () :: !filters;

     

       44
       +
         let filter = Query.and_filter !filters in

     

       45
       +
         let* results =

     

       46
       +
           Query.query ~fs calendar_dir ~filter ~from ~to_ ?limit:count ()

     

       47
       +
         in

     

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

     

       49
       +
         else print_endline (Format.format_instances ~format results);

     

       50
       +
         Ok ()

     

       51
       +
       

     

       52
       +
       let query_text_arg =

     

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

     

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

     

       55
       +
       

     

       56
       +
       let summary_arg =

     

       57
       +
         let doc = "Search in event summaries only" in

     

       58
       +
         Arg.(value & flag & info [ "summary"; "s" ] ~doc)

     

       59
       +
       

     

       60
       +
       let description_arg =

     

       61
       +
         let doc = "Search in event descriptions only" in

     

       62
       +
         Arg.(value & flag & info [ "description"; "D" ] ~doc)

     

       63
       +
       

     

       64
       +
       let location_arg =

     

       65
       +
         let doc = "Search in event locations only" in

     

       66
       +
         Arg.(value & flag & info [ "location"; "l" ] ~doc)

     

       67
       +
       

     

       68
       +
       let recurring_arg =

     

       69
       +
         let doc = "Search for recurring events only" in

     

       70
       +
         Arg.(value & flag & info [ "recurring"; "r" ] ~doc)

     

       71
       +
       

     

       72
       +
       let non_recurring_arg =

     

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

     

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

     

       75
       +
       

     

       76
       +
       let cmd ~fs calendar_dir =

     

       77
       +
         let run query_text from to_ calendar count format summary description location

     

       78
       +
             today tomorrow week month recurring non_recurring =

     

       79
       +
           match

     

       80
       +
             run ?from ?to_ ?calendar ?count ?query_text ~summary ~description

     

       81
       +
               ~location ~format ~today ~tomorrow ~week ~month ~recurring

     

       82
       +
               ~non_recurring ~fs calendar_dir

     

       83
       +
           with

     

       84
       +
           | Error (`Msg msg) ->

     

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

     

       86
       +
               1

     

       87
       +
           | Ok () -> 0

     

       88
       +
         in

     

       89
       +
         let term =

     

       90
       +
           Term.(

     

       91
       +
             const run $ query_text_arg $ from_arg $ to_arg $ calendar_arg $ count_arg

     

       92
       +
             $ format_arg $ summary_arg $ description_arg $ location_arg $ today_arg

     

       93
       +
             $ tomorrow_arg $ week_arg $ month_arg $ recurring_arg $ non_recurring_arg)

     

       94
       +
         in

     

       95
       +
         let doc = "Search calendar events for specific text" in

     

       96
       +
         let man =

     

       97
       +
           [

     

       98
       +
             `S Manpage.s_description;

     

       99
       +
             `P

     

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

     

       101
       +
                fields.";

     

       102
       +
             `P

     

       103
       +
               "By default, the search looks across all text fields in all events \

     

       104
       +
                regardless of date.";

     

       105
       +
             `P

     

       106
       +
               "You can narrow the search to a specific date range with date flags or \

     

       107
       +
                --from and --to.";

     

       108
       +
             `P

     

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

     

       110
       +
                --description, or --location flags.";

     

       111
       +
             `P

     

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

     

       113
       +
                the --recurring or --non-recurring flags.";

     

       114
       +
             `P

     

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

     

       116
       +
                example, you can find all recurring events without specifying any \

     

       117
       +
                search text.";

     

       118
       +
             `S Manpage.s_options;

     

       119
       +
             `S "DATE FORMATS";

     

       120
       +
           ]

     

       121
       +
           @ date_format_manpage_entries

     

       122
       +
           @ [

     

       123
       +
               `S "EXAMPLES";

     

       124
       +
               `P "Search for 'meeting' in all events:";

     

       125
       +
               `P "  caled search meeting";

     

       126
       +
               `P "Search for 'interview' in event summaries only:";

     

       127
       +
               `P "  caled search --summary interview";

     

       128
       +
               `P "Search for 'conference' in a specific calendar:";

     

       129
       +
               `P "  caled search --calendar work conference";

     

       130
       +
               `P "Search for 'workshop' in event descriptions for today only:";

     

       131
       +
               `P "  caled search --description --today workshop";

     

       132
       +
               `P "Search for 'project' in events this month:";

     

       133
       +
               `P "  caled search --month project";

     

       134
       +
               `P "Search for 'workshop' in event descriptions within a date range:";

     

       135
       +
               `P

     

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

     

       137
       +
                  workshop";

     

       138
       +
               `P "Search for recurring events only:";

     

       139
       +
               `P "  caled search --recurring meeting";

     

       140
       +
               `P "Search for non-recurring events only:";

     

       141
       +
               `P "  caled search --non-recurring appointment";

     

       142
       +
               `P "Find all recurring events:";

     

       143
       +
               `P "  caled search --recurring";

     

       144
       +
               `P "Find all events in a specific calendar:";

     

       145
       +
               `P "  caled search --calendar work";

     

       146
       +
             ]

     

       147
       +
         in

     

       148
       +
         let exit_info =

     

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

     

       150
       +
         in

     

       151
       +
       

     

       152
       +
         let info = Cmd.info "search" ~doc ~man ~exits:exit_info in

     

       153
       +
         Cmd.v info term

+29

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"

     

       6
       +
       bug-reports: "https://github.com/RyanGibb/caledonia/issues"

     

       7
       +
       dev-repo: "git+https://github.com/RyanGibb/caledonia.git"

     

       8
       +
       license: "MIT"

     

       9
       +
       synopsis: "Command-line calendar tool"

     

       10
       +
       build: [

     

       11
       +
         ["dune" "subst"] {pinned}

     

       12
       +
         ["dune" "build" "-p" name "-j" jobs]

     

       13
       +
       ]

     

       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"}

     

       21
       +
         "logs" {>= "0.7.0"}

     

       22
       +
         "re" {>= "1.12.0"}

     

       23
       +
         "yojson" {>= "2.2.2"}

     

       24
       +
         "uuidm" {>= "0.9.9"}

     

       25
       +
         "eio" {>= "0.12"}

     

       26
       +
         "eio_main" {>= "0.12"}

     

       27
       +
         "calendar" {>= "3.0.0"}

     

       28
       +
         "alcotest" {>= "1.8.0" & with-test}

     

       29
       +
       ]

dune-project

···

       1
       +
       (lang dune 3.4)

     

       2
       +
       (name caledonia)

     

       3
       +
       (version 0.1.0)

     

       4
       +
       (using directory-targets 0.1)

+112

lib/calendar_dir.ml

···

       1
       +
       open Icalendar

     

       2
       +
       

     

       3
       +
       type collection = Collection of string

     

       4
       +
       type calendar_file = { calendar : calendar; file_path : string }

     

       5
       +
       

     

       6
       +
       module CollectionMap = Map.Make (struct

     

       7
       +
         type t = collection

     

       8
       +
       

     

       9
       +
         let compare (Collection a) (Collection b) = String.compare a b

     

       10
       +
       end)

     

       11
       +
       

     

       12
       +
       type calendar_dir = {

     

       13
       +
         path : string;

     

       14
       +
         mutable collections : calendar_file list CollectionMap.t;

     

       15
       +
       }

     

       16
       +
       

     

       17
       +
       let collection_path calendar_dir (Collection collection_name) =

     

       18
       +
         Filename.concat calendar_dir.path collection_name

     

       19
       +
       

     

       20
       +
       let ensure_dir ~fs path =

     

       21
       +
         try

     

       22
       +
           if not (Sys.file_exists path) then (

     

       23
       +
             Eio.Path.(mkdir ~perm:0o755 (fs / path));

     

       24
       +
             Ok ())

     

       25
       +
           else if not (Sys.is_directory path) then

     

       26
       +
             Error (`Msg (Printf.sprintf "%s exists but is not a directory" path))

     

       27
       +
           else Ok ()

     

       28
       +
         with Eio.Exn.Io _ as exn ->

     

       29
       +
           Error

     

       30
       +
             (`Msg (Fmt.str "Failed to create directory %s: %a" path Eio.Exn.pp exn))

     

       31
       +
       

     

       32
       +
       let create ~fs path =

     

       33
       +
         match ensure_dir ~fs path with

     

       34
       +
         | Ok () -> Ok { path; collections = CollectionMap.empty }

     

       35
       +
         | Error e -> Error e

     

       36
       +
       

     

       37
       +
       let list_collections ~fs calendar_dir =

     

       38
       +
         try

     

       39
       +
           let dir_path = Eio.Path.(fs / calendar_dir.path) in

     

       40
       +
           let collections =

     

       41
       +
             Eio.Path.read_dir dir_path

     

       42
       +
             |> List.filter_map (fun file ->

     

       43
       +
                    let path = Filename.concat calendar_dir.path file in

     

       44
       +
                    if Sys.is_directory path then Some (Collection file) else None)

     

       45
       +
             |> List.sort (fun (Collection a) (Collection b) -> String.compare a b)

     

       46
       +
           in

     

       47
       +
           Ok collections

     

       48
       +
         with Eio.Exn.Io _ as exn ->

     

       49
       +
           Error

     

       50
       +
             (`Msg

     

       51
       +
                (Fmt.str "Failed to list calendar directory %s: %a" calendar_dir.path

     

       52
       +
                   Eio.Exn.pp exn))

     

       53
       +
       

     

       54
       +
       let get_collection ~fs calendar_dir collection =

     

       55
       +
         match CollectionMap.find_opt collection calendar_dir.collections with

     

       56
       +
         | Some calendars -> Ok calendars

     

       57
       +
         | None -> (

     

       58
       +
             let collection_path = collection_path calendar_dir collection in

     

       59
       +
             if not (Sys.is_directory collection_path) then Error `Not_found

     

       60
       +
             else

     

       61
       +
               try

     

       62
       +
                 let files = Sys.readdir collection_path in

     

       63
       +
                 let calendar_files =

     

       64
       +
                   List.filter_map

     

       65
       +
                     (fun filename ->

     

       66
       +
                       match Filename.check_suffix filename ".ics" with

     

       67
       +
                       | false -> None

     

       68
       +
                       | true -> (

     

       69
       +
                           let file = Eio.Path.(fs / collection_path / filename) in

     

       70
       +
                           let _, file_path = file in

     

       71
       +
                           try

     

       72
       +
                             let content = Eio.Path.load file in

     

       73
       +
                             match parse content with

     

       74
       +
                             | Ok calendar -> Some { calendar; file_path }

     

       75
       +
                             | Error err ->

     

       76
       +
                                 Printf.eprintf "Failed to parse %s: %s\n%!" file_path

     

       77
       +
                                   err;

     

       78
       +
                                 None

     

       79
       +
                           with Eio.Exn.Io _ as exn ->

     

       80
       +
                             Fmt.epr "Failed to read file %s: %a\n%!" file_path

     

       81
       +
                               Eio.Exn.pp exn;

     

       82
       +
                             None))

     

       83
       +
                     (Array.to_list files)

     

       84
       +
                 in

     

       85
       +
                 calendar_dir.collections <-

     

       86
       +
                   CollectionMap.add collection calendar_files calendar_dir.collections;

     

       87
       +
                 Ok calendar_files

     

       88
       +
               with e ->

     

       89
       +
                 Error

     

       90
       +
                   (`Msg

     

       91
       +
                      (Printf.sprintf "Exception processing directory %s: %s"

     

       92
       +
                         collection_path (Printexc.to_string e))))

     

       93
       +
       

     

       94
       +
       let get_collections ~fs calendar_dir =

     

       95
       +
         match list_collections ~fs calendar_dir with

     

       96
       +
         | Error e -> Error e

     

       97
       +
         | Ok ids -> (

     

       98
       +
             try

     

       99
       +
               let rec process_ids acc = function

     

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

     

       101
       +
                 | id :: rest -> (

     

       102
       +
                     match get_collection ~fs calendar_dir id with

     

       103
       +
                     | Ok cal -> process_ids ((id, cal) :: acc) rest

     

       104
       +
                     | Error `Not_found -> process_ids acc rest

     

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

     

       106
       +
               in

     

       107
       +
               process_ids [] ids

     

       108
       +
             with exn ->

     

       109
       +
               Error

     

       110
       +
                 (`Msg

     

       111
       +
                    (Printf.sprintf "Error getting collections: %s"

     

       112
       +
                       (Printexc.to_string exn))))

+45

lib/calendar_dir.mli

···

       1
       +
       (** Functions for managing calendar directories with collections of .ics files

     

       2
       +
       *)

     

       3
       +
       

     

       4
       +
       type collection = Collection of string  (** The name of the collection. *)

     

       5
       +
       

     

       6
       +
       module CollectionMap : Map.S with type key = collection

     

       7
       +
       (** Module for mapping collection names to their calendar files *)

     

       8
       +
       

     

       9
       +
       type calendar_file = { calendar : Icalendar.calendar; file_path : string }

     

       10
       +
       (** Record representing a calendar file with its metadata *)

     

       11
       +
       

     

       12
       +
       type calendar_dir

     

       13
       +
       (** A directory of collections, where each collection is a subdirectory

     

       14
       +
           containing .ics files *)

     

       15
       +
       

     

       16
       +
       val create :

     

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

     

       18
       +
         string ->

     

       19
       +
         (calendar_dir, [> `Msg of string ]) result

     

       20
       +
       (** Create a calendar_dir from a directory path. Returns Ok with the

     

       21
       +
           calendar_dir if successful, or Error with a message if the directory cannot

     

       22
       +
           be created or accessed. *)

     

       23
       +
       

     

       24
       +
       val list_collections :

     

       25
       +
         fs:[> Eio.Fs.dir_ty ] Eio.Path.t ->

     

       26
       +
         calendar_dir ->

     

       27
       +
         (collection list, [> `Msg of string ]) result

     

       28
       +
       (** List available collections in the calendar_dir. Returns Ok with the list of

     

       29
       +
           collection names if successful, or Error with a message if the directory

     

       30
       +
           cannot be read. *)

     

       31
       +
       

     

       32
       +
       val get_collection :

     

       33
       +
         fs:[> Eio.Fs.dir_ty ] Eio.Path.t ->

     

       34
       +
         calendar_dir ->

     

       35
       +
         collection ->

     

       36
       +
         (calendar_file list, [> `Msg of string | `Not_found ]) result

     

       37
       +
       (** Get all calendar files in a collection. If the collection doesn't exist in

     

       38
       +
           the cache, it will be loaded from disk. *)

     

       39
       +
       

     

       40
       +
       val get_collections :

     

       41
       +
         fs:[> Eio.Fs.dir_ty ] Eio.Path.t ->

     

       42
       +
         calendar_dir ->

     

       43
       +
         ((collection * calendar_file list) list, [> `Msg of string ]) result

     

       44
       +
       (** Get all collections with their calendar files. This will load any

     

       45
       +
           collections that haven't been loaded yet. *)

+17

lib/dune

···

       1
       +
       (library

     

       2
       +
        (name caledonia_lib)

     

       3
       +
        (public_name caledonia.lib)

     

       4
       +
        (libraries

     

       5
       +
         icalendar

     

       6
       +
         ptime

     

       7
       +
         ptime.clock.os

     

       8
       +
         calendar

     

       9
       +
         fmt

     

       10
       +
         logs

     

       11
       +
         re

     

       12
       +
         yojson

     

       13
       +
         uuidm

     

       14
       +
         eio

     

       15
       +
         eio_main)

     

       16
       +
        (preprocess

     

       17
       +
         (pps ppx_deriving.show ppx_deriving.eq)))

+140

lib/event.ml

···

       1
       +
       open Icalendar

     

       2
       +
       

     

       3
       +
       type event_id = string

     

       4
       +
       

     

       5
       +
       type t = {

     

       6
       +
         id : event_id;

     

       7
       +
         summary : string;

     

       8
       +
         start : Ptime.t;

     

       9
       +
         end_ : Ptime.t option;

     

       10
       +
         location : string option;

     

       11
       +
         description : string option;

     

       12
       +
         recurrence : recurrence option;

     

       13
       +
         collection : Calendar_dir.collection option;

     

       14
       +
       }

     

       15
       +
       

     

       16
       +
       type date_error = [ `Msg of string ]

     

       17
       +
       

     

       18
       +
       let ptime_of_datetime = function

     

       19
       +
         | `Datetime (`Utc t) -> Ok t

     

       20
       +
         | `Datetime (`Local t) -> Ok t

     

       21
       +
         (* TODO handle timezones *)

     

       22
       +
         | `Datetime (`With_tzid (t, _)) -> Ok t

     

       23
       +
         | `Date date -> (

     

       24
       +
             match Ptime.of_date_time (date, ((0, 0, 0), 0)) with

     

       25
       +
             | Some t -> Ok t

     

       26
       +
             | None ->

     

       27
       +
                 let year, month, day = date in

     

       28
       +
                 Error (`Msg (Printf.sprintf "Invalid date %d-%d-%d" year month day)))

     

       29
       +
       

     

       30
       +
       let generate_uuid () =

     

       31
       +
         let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) () in

     

       32
       +
         Uuidm.to_string uuid

     

       33
       +
       

     

       34
       +
       let create ?collection ~summary ~start ?end_ ?location ?description ?recurrence

     

       35
       +
           () =

     

       36
       +
         {

     

       37
       +
           id = generate_uuid ();

     

       38
       +
           summary;

     

       39
       +
           start;

     

       40
       +
           end_;

     

       41
       +
           location;

     

       42
       +
           description;

     

       43
       +
           recurrence;

     

       44
       +
           collection;

     

       45
       +
         }

     

       46
       +
       

     

       47
       +
       let of_icalendar collection ical_event =

     

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

     

       49
       +
         let* start = ptime_of_datetime (snd ical_event.dtstart) in

     

       50
       +
         let* end_ =

     

       51
       +
           match ical_event.dtend_or_duration with

     

       52
       +
           | Some (`Dtend (_, dt)) -> (

     

       53
       +
               match ptime_of_datetime dt with

     

       54
       +
               | Ok t -> Ok (Some t)

     

       55
       +
               | Error msg -> Error msg)

     

       56
       +
           | Some (`Duration (_, span)) -> (

     

       57
       +
               match Ptime.add_span start span with

     

       58
       +
               | Some t -> Ok (Some t)

     

       59
       +
               | None ->

     

       60
       +
                   Error

     

       61
       +
                     (`Msg

     

       62
       +
                        (Printf.sprintf "Invalid duration calculation: %s + %s"

     

       63
       +
                           (Ptime.to_rfc3339 start)

     

       64
       +
                           (Printf.sprintf "%.2fs" (Ptime.Span.to_float_s span)))))

     

       65
       +
           | None -> Ok None

     

       66
       +
         in

     

       67
       +
       

     

       68
       +
         let recurrence = Option.map snd ical_event.rrule in

     

       69
       +
         let uid_ref = ref None in

     

       70
       +
         let summary_ref = ref None in

     

       71
       +
         let location_ref = ref None in

     

       72
       +
         let description_ref = ref None in

     

       73
       +
         (* TODO we might want to consider using more properties *)

     

       74
       +
         List.iter

     

       75
       +
           (function

     

       76
       +
             | `Summary (_, s) when s <> "" -> summary_ref := Some s

     

       77
       +
             | `Location (_, s) -> location_ref := Some s

     

       78
       +
             | `Description (_, s) -> description_ref := Some s

     

       79
       +
             | `Uid (_, s) when s <> "" -> uid_ref := Some s

     

       80
       +
             | _ -> ())

     

       81
       +
           ical_event.props;

     

       82
       +
         (* TODO these should probably be required *)

     

       83
       +
         let summary =

     

       84
       +
           match !summary_ref with Some s -> s | None -> "Untitled Event"

     

       85
       +
         in

     

       86
       +
         let id = match !uid_ref with Some s -> s | None -> generate_uuid () in

     

       87
       +
         Ok

     

       88
       +
           {

     

       89
       +
             id;

     

       90
       +
             summary;

     

       91
       +
             start;

     

       92
       +
             end_;

     

       93
       +
             location = !location_ref;

     

       94
       +
             description = !description_ref;

     

       95
       +
             recurrence;

     

       96
       +
             collection = Some collection;

     

       97
       +
           }

     

       98
       +
       

     

       99
       +
       (* TODO retain unused parameters *)

     

       100
       +
       let to_icalendar t =

     

       101
       +
         let now = Ptime_clock.now () in

     

       102
       +
         let props = [] in

     

       103
       +
         let props = `Summary (Params.empty, t.summary) :: props in

     

       104
       +
         let props =

     

       105
       +
           match t.location with

     

       106
       +
           | Some loc -> `Location (Params.empty, loc) :: props

     

       107
       +
           | None -> props

     

       108
       +
         in

     

       109
       +
         let props =

     

       110
       +
           match t.description with

     

       111
       +
           | Some desc -> `Description (Params.empty, desc) :: props

     

       112
       +
           | None -> props

     

       113
       +
         in

     

       114
       +
         {

     

       115
       +
           dtstamp = (Params.empty, now);

     

       116
       +
           uid = (Params.empty, t.id);

     

       117
       +
           dtstart = (Params.empty, `Datetime (`Utc t.start));

     

       118
       +
           dtend_or_duration =

     

       119
       +
             Option.map (fun e -> `Dtend (Params.empty, `Datetime (`Utc e))) t.end_;

     

       120
       +
           rrule = Option.map (fun r -> (Params.empty, r)) t.recurrence;

     

       121
       +
           props;

     

       122
       +
           alarms = [];

     

       123
       +
         }

     

       124
       +
       

     

       125
       +
       let get_id t = t.id

     

       126
       +
       let get_summary t = t.summary

     

       127
       +
       let get_start t = t.start

     

       128
       +
       let get_end t = t.end_

     

       129
       +
       

     

       130
       +
       let get_duration t =

     

       131
       +
         match t.end_ with

     

       132
       +
         | Some e ->

     

       133
       +
             let span = Ptime.diff e t.start in

     

       134
       +
             Some span

     

       135
       +
         | None -> None

     

       136
       +
       

     

       137
       +
       let get_location t = t.location

     

       138
       +
       let get_description t = t.description

     

       139
       +
       let get_recurrence t = t.recurrence

     

       140
       +
       let get_collection t = t.collection

+40

lib/event.mli

···

       1
       +
       (** Core event functionality and data access *)

     

       2
       +
       

     

       3
       +
       type event_id = string

     

       4
       +
       (** Event ID type *)

     

       5
       +
       

     

       6
       +
       type t

     

       7
       +
       (** Event type representing a calendar event *)

     

       8
       +
       

     

       9
       +
       type date_error = [ `Msg of string ]

     

       10
       +
       (** Type for date-related errors *)

     

       11
       +
       

     

       12
       +
       val create :

     

       13
       +
         ?collection:Calendar_dir.collection ->

     

       14
       +
         summary:string ->

     

       15
       +
         start:Ptime.t ->

     

       16
       +
         ?end_:Ptime.t ->

     

       17
       +
         ?location:string ->

     

       18
       +
         ?description:string ->

     

       19
       +
         ?recurrence:Icalendar.recurrence ->

     

       20
       +
         unit ->

     

       21
       +
         t

     

       22
       +
       (** Create a new event with required properties *)

     

       23
       +
       

     

       24
       +
       val of_icalendar :

     

       25
       +
         Calendar_dir.collection -> Icalendar.event -> (t, date_error) result

     

       26
       +
       (** Convert an Icalendar event to our event type. Returns Ok with the event or

     

       27
       +
           Error with a message. *)

     

       28
       +
       

     

       29
       +
       val to_icalendar : t -> Icalendar.event

     

       30
       +
       (** Convert our event type to an Icalendar event *)

     

       31
       +
       

     

       32
       +
       val get_id : t -> event_id

     

       33
       +
       val get_summary : t -> string

     

       34
       +
       val get_start : t -> Ptime.t

     

       35
       +
       val get_end : t -> Ptime.t option

     

       36
       +
       val get_duration : t -> Ptime.span option

     

       37
       +
       val get_location : t -> string option

     

       38
       +
       val get_description : t -> string option

     

       39
       +
       val get_recurrence : t -> Icalendar.recurrence option

     

       40
       +
       val get_collection : t -> Calendar_dir.collection option

+353

lib/format.ml

···

       1
       +
       type format = [ `Text | `Json | `Csv | `Ics | `Table | `Sexp ]

     

       2
       +
       

     

       3
       +
       let format_date date =

     

       4
       +
         let y, m, d = Ptime.to_date date in

     

       5
       +
         let cal_date = CalendarLib.Date.make y m d in

     

       6
       +
         let weekday =

     

       7
       +
           match CalendarLib.Date.day_of_week cal_date with

     

       8
       +
           | CalendarLib.Date.Mon -> "Mon"

     

       9
       +
           | CalendarLib.Date.Tue -> "Tue"

     

       10
       +
           | CalendarLib.Date.Wed -> "Wed"

     

       11
       +
           | CalendarLib.Date.Thu -> "Thu"

     

       12
       +
           | CalendarLib.Date.Fri -> "Fri"

     

       13
       +
           | CalendarLib.Date.Sat -> "Sat"

     

       14
       +
           | CalendarLib.Date.Sun -> "Sun"

     

       15
       +
         in

     

       16
       +
         Printf.sprintf "%04d-%02d-%02d %s" y m d weekday

     

       17
       +
       

     

       18
       +
       let format_time date =

     

       19
       +
         let _, ((h, m, _), _) = Ptime.to_date_time date in

     

       20
       +
         Printf.sprintf "%02d:%02d" h m

     

       21
       +
       

     

       22
       +
       let format_datetime date =

     

       23
       +
         Printf.sprintf "%s %s" (format_date date) (format_time date)

     

       24
       +
       

     

       25
       +
       let format_event ?(format = `Text) event =

     

       26
       +
         let open Event in

     

       27
       +
         match format with

     

       28
       +
         | `Text ->

     

       29
       +
             let summary = get_summary event in

     

       30
       +
             let date = format_date (get_start event) in

     

       31
       +
             let time = format_time (get_start event) in

     

       32
       +
             let end_time_str =

     

       33
       +
               match get_end event with

     

       34
       +
               | Some e -> Printf.sprintf "-%s" (format_time e)

     

       35
       +
               | None -> ""

     

       36
       +
             in

     

       37
       +
             let location_str =

     

       38
       +
               match get_location event with

     

       39
       +
               | Some loc when loc <> "" -> Printf.sprintf " @ %s" loc

     

       40
       +
               | _ -> ""

     

       41
       +
             in

     

       42
       +
             let recur_str =

     

       43
       +
               match get_recurrence event with

     

       44
       +
               | Some _ -> Printf.sprintf " (recurring)"

     

       45
       +
               | None -> ""

     

       46
       +
             in

     

       47
       +
             Printf.sprintf "%s %s%s %s%s%s" date time end_time_str summary

     

       48
       +
               location_str recur_str

     

       49
       +
         | `Json ->

     

       50
       +
             let open Yojson.Safe in

     

       51
       +
             let json =

     

       52
       +
               `Assoc

     

       53
       +
                 [

     

       54
       +
                   ("id", `String (get_id event));

     

       55
       +
                   ("summary", `String (get_summary event));

     

       56
       +
                   ("start", `String (format_datetime (get_start event)));

     

       57
       +
                   ( "end",

     

       58
       +
                     match get_end event with

     

       59
       +
                     | Some e -> `String (format_datetime e)

     

       60
       +
                     | None -> `Null );

     

       61
       +
                   ( "location",

     

       62
       +
                     match get_location event with

     

       63
       +
                     | Some loc -> `String loc

     

       64
       +
                     | None -> `Null );

     

       65
       +
                   ( "description",

     

       66
       +
                     match get_description event with

     

       67
       +
                     | Some desc -> `String desc

     

       68
       +
                     | None -> `Null );

     

       69
       +
                   ( "calendar",

     

       70
       +
                     match get_collection event with

     

       71
       +
                     | Some (Calendar_dir.Collection cal) -> `String cal

     

       72
       +
                     | None -> `Null );

     

       73
       +
                 ]

     

       74
       +
             in

     

       75
       +
             to_string json

     

       76
       +
         | `Csv ->

     

       77
       +
             let summary = get_summary event in

     

       78
       +
             let start = format_datetime (get_start event) in

     

       79
       +
             let end_str =

     

       80
       +
               match get_end event with Some e -> format_datetime e | None -> ""

     

       81
       +
             in

     

       82
       +
             let location =

     

       83
       +
               match get_location event with Some loc -> loc | None -> ""

     

       84
       +
             in

     

       85
       +
             let cal_id =

     

       86
       +
               match get_collection event with

     

       87
       +
               | Some (Calendar_dir.Collection cal) -> cal

     

       88
       +
               | None -> ""

     

       89
       +
             in

     

       90
       +
             Printf.sprintf "\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" summary start end_str

     

       91
       +
               location cal_id

     

       92
       +
         | `Ics ->

     

       93
       +
             let cal_props = [] in

     

       94
       +
             let event_ical = Event.to_icalendar event in

     

       95
       +
             Icalendar.to_ics (cal_props, [ `Event event_ical ])

     

       96
       +
         | `Table ->

     

       97
       +
             let width = 80 in

     

       98
       +
             let hr = String.make width '-' in

     

       99
       +
             let summary = get_summary event in

     

       100
       +
             let start = format_datetime (get_start event) in

     

       101
       +
             let end_str =

     

       102
       +
               match get_end event with Some e -> format_datetime e | None -> ""

     

       103
       +
             in

     

       104
       +
             let location =

     

       105
       +
               match get_location event with Some loc -> loc | None -> ""

     

       106
       +
             in

     

       107
       +
             Printf.sprintf

     

       108
       +
               "%s\n\

     

       109
       +
                | %-20s | %-30s |\n\

     

       110
       +
                | %-20s | %-30s |\n\

     

       111
       +
                | %-20s | %-30s |\n\

     

       112
       +
                | %-20s | %-30s |\n\

     

       113
       +
                %s"

     

       114
       +
               hr "Summary" summary "Start" start "End" end_str "Location" location hr

     

       115
       +
         | `Sexp ->

     

       116
       +
             let summary = get_summary event in

     

       117
       +
             let start_date, start_time =

     

       118
       +
               let date = get_start event in

     

       119
       +
               let y, m, d = Ptime.to_date date in

     

       120
       +
               let _, ((h, min, s), _) = Ptime.to_date_time date in

     

       121
       +
               let cal_date = CalendarLib.Date.make y m d in

     

       122
       +
               let dow =

     

       123
       +
                 match CalendarLib.Date.day_of_week cal_date with

     

       124
       +
                 | CalendarLib.Date.Mon -> "monday"

     

       125
       +
                 | CalendarLib.Date.Tue -> "tuesday"

     

       126
       +
                 | CalendarLib.Date.Wed -> "wednesday"

     

       127
       +
                 | CalendarLib.Date.Thu -> "thursday"

     

       128
       +
                 | CalendarLib.Date.Fri -> "friday"

     

       129
       +
                 | CalendarLib.Date.Sat -> "saturday"

     

       130
       +
                 | CalendarLib.Date.Sun -> "sunday"

     

       131
       +
               in

     

       132
       +
               ( Printf.sprintf "(%04d %02d %02d %s)" y m d dow,

     

       133
       +
                 Printf.sprintf "(%02d %02d %02d)" h min s )

     

       134
       +
             in

     

       135
       +
             let end_str =

     

       136
       +
               match get_end event with

     

       137
       +
               | Some end_date ->

     

       138
       +
                   let y, m, d = Ptime.to_date end_date in

     

       139
       +
                   let _, ((h, min, s), _) = Ptime.to_date_time end_date in

     

       140
       +
                   let cal_date = CalendarLib.Date.make y m d in

     

       141
       +
                   let dow =

     

       142
       +
                     match CalendarLib.Date.day_of_week cal_date with

     

       143
       +
                     | CalendarLib.Date.Mon -> "monday"

     

       144
       +
                     | CalendarLib.Date.Tue -> "tuesday"

     

       145
       +
                     | CalendarLib.Date.Wed -> "wednesday"

     

       146
       +
                     | CalendarLib.Date.Thu -> "thursday"

     

       147
       +
                     | CalendarLib.Date.Fri -> "friday"

     

       148
       +
                     | CalendarLib.Date.Sat -> "saturday"

     

       149
       +
                     | CalendarLib.Date.Sun -> "sunday"

     

       150
       +
                   in

     

       151
       +
                   Printf.sprintf "((%04d %02d %02d %s) (%02d %02d %02d))" y m d dow h

     

       152
       +
                     min s

     

       153
       +
               | None -> "nil"

     

       154
       +
             in

     

       155
       +
             let location =

     

       156
       +
               match get_location event with

     

       157
       +
               | Some loc -> Printf.sprintf "\"%s\"" (String.escaped loc)

     

       158
       +
               | None -> "nil"

     

       159
       +
             in

     

       160
       +
             let description =

     

       161
       +
               match get_description event with

     

       162
       +
               | Some desc -> Printf.sprintf "\"%s\"" (String.escaped desc)

     

       163
       +
               | None -> "nil"

     

       164
       +
             in

     

       165
       +
             let calendar =

     

       166
       +
               match get_collection event with

     

       167
       +
               | Some (Calendar_dir.Collection cal) ->

     

       168
       +
                   Printf.sprintf "\"%s\"" (String.escaped cal)

     

       169
       +
               | None -> "nil"

     

       170
       +
             in

     

       171
       +
             let id = get_id event in

     

       172
       +
             Printf.sprintf

     

       173
       +
               "((:id \"%s\" :summary \"%s\" :start (%s %s) :end %s :location %s \

     

       174
       +
                :description %s :calendar %s))"

     

       175
       +
               (String.escaped id) (String.escaped summary) start_date start_time

     

       176
       +
               end_str location description calendar

     

       177
       +
       

     

       178
       +
       let format_instance ?(format = `Text) instance =

     

       179
       +
         match format with

     

       180
       +
         | `Text ->

     

       181
       +
             let summary = Event.get_summary instance.Recur.event in

     

       182
       +
             let date = format_date instance.Recur.start in

     

       183
       +
             let time = format_time instance.Recur.start in

     

       184
       +
             let end_time_str =

     

       185
       +
               match instance.Recur.end_ with

     

       186
       +
               | Some e -> Printf.sprintf "-%s" (format_time e)

     

       187
       +
               | None -> ""

     

       188
       +
             in

     

       189
       +
             let location_str =

     

       190
       +
               match Event.get_location instance.Recur.event with

     

       191
       +
               | Some loc when loc <> "" -> Printf.sprintf " @ %s" loc

     

       192
       +
               | _ -> ""

     

       193
       +
             in

     

       194
       +
             Printf.sprintf "%s %s%s %s%s" date time end_time_str summary location_str

     

       195
       +
         | format -> format_event ~format instance.Recur.event

     

       196
       +
       

     

       197
       +
       let format_events ?(format = `Text) events =

     

       198
       +
         match format with

     

       199
       +
         | `Json ->

     

       200
       +
             let json_events =

     

       201
       +
               List.map

     

       202
       +
                 (fun e -> Yojson.Safe.from_string (format_event ~format:`Json e))

     

       203
       +
                 events

     

       204
       +
             in

     

       205
       +
             Yojson.Safe.to_string (`List json_events)

     

       206
       +
         | `Csv ->

     

       207
       +
             "\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"

     

       208
       +
             ^ String.concat "\n"

     

       209
       +
                 (List.map

     

       210
       +
                    (fun e ->

     

       211
       +
                      let summary = Event.get_summary e in

     

       212
       +
                      let start = format_datetime (Event.get_start e) in

     

       213
       +
                      let end_str =

     

       214
       +
                        match Event.get_end e with

     

       215
       +
                        | Some end_ -> format_datetime end_

     

       216
       +
                        | None -> ""

     

       217
       +
                      in

     

       218
       +
                      let location =

     

       219
       +
                        match Event.get_location e with Some loc -> loc | None -> ""

     

       220
       +
                      in

     

       221
       +
                      let cal_id =

     

       222
       +
                        match Event.get_collection e with

     

       223
       +
                        | Some (Calendar_dir.Collection cal) -> cal

     

       224
       +
                        | None -> ""

     

       225
       +
                      in

     

       226
       +
                      Printf.sprintf "\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" summary start

     

       227
       +
                        end_str location cal_id)

     

       228
       +
                    events)

     

       229
       +
         | `Sexp ->

     

       230
       +
             (* For S-expressions, we want a list of event S-expressions *)

     

       231
       +
             "("

     

       232
       +
             ^ String.concat "\n "

     

       233
       +
                 (List.map (fun e -> format_event ~format:`Sexp e) events)

     

       234
       +
             ^ ")"

     

       235
       +
         | _ -> String.concat "\n" (List.map (fun e -> format_event ~format e) events)

     

       236
       +
       

     

       237
       +
       let format_instances ?(format = `Text) instances =

     

       238
       +
         match format with

     

       239
       +
         | `Json ->

     

       240
       +
             let json_instances =

     

       241
       +
               List.map

     

       242
       +
                 (fun i ->

     

       243
       +
                   let e = i.Recur.event in

     

       244
       +
                   let json = Yojson.Safe.from_string (format_event ~format:`Json e) in

     

       245
       +
                   match json with

     

       246
       +
                   | `Assoc fields ->

     

       247
       +
                       `Assoc

     

       248
       +
                         (("start", `String (format_datetime i.Recur.start))

     

       249
       +
                         :: ( "end",

     

       250
       +
                              match i.Recur.end_ with

     

       251
       +
                              | Some e -> `String (format_datetime e)

     

       252
       +
                              | None -> `Null )

     

       253
       +
                         :: List.filter

     

       254
       +
                              (fun (k, _) -> k <> "start" && k <> "end")

     

       255
       +
                              fields)

     

       256
       +
                   | _ -> json)

     

       257
       +
                 instances

     

       258
       +
             in

     

       259
       +
             Yojson.Safe.to_string (`List json_instances)

     

       260
       +
         | `Csv ->

     

       261
       +
             "\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"

     

       262
       +
             ^ String.concat "\n"

     

       263
       +
                 (List.map

     

       264
       +
                    (fun i ->

     

       265
       +
                      let e = i.Recur.event in

     

       266
       +
                      let summary = Event.get_summary e in

     

       267
       +
                      let start = format_datetime i.Recur.start in

     

       268
       +
                      let end_str =

     

       269
       +
                        match i.Recur.end_ with

     

       270
       +
                        | Some end_ -> format_datetime end_

     

       271
       +
                        | None -> ""

     

       272
       +
                      in

     

       273
       +
                      let location =

     

       274
       +
                        match Event.get_location e with Some loc -> loc | None -> ""

     

       275
       +
                      in

     

       276
       +
                      let cal_id =

     

       277
       +
                        match Event.get_collection e with

     

       278
       +
                        | Some (Calendar_dir.Collection cal) -> cal

     

       279
       +
                        | None -> ""

     

       280
       +
                      in

     

       281
       +
                      Printf.sprintf "\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" summary start

     

       282
       +
                        end_str location cal_id)

     

       283
       +
                    instances)

     

       284
       +
         | `Sexp ->

     

       285
       +
             (* Create a list of instance S-expressions *)

     

       286
       +
             let format_instance_sexp i =

     

       287
       +
               let e = i.Recur.event in

     

       288
       +
               let summary = Event.get_summary e in

     

       289
       +
               let start_date, start_time =

     

       290
       +
                 let date = i.Recur.start in

     

       291
       +
                 let y, m, d = Ptime.to_date date in

     

       292
       +
                 let _, ((h, min, s), _) = Ptime.to_date_time date in

     

       293
       +
                 let cal_date = CalendarLib.Date.make y m d in

     

       294
       +
                 let dow =

     

       295
       +
                   match CalendarLib.Date.day_of_week cal_date with

     

       296
       +
                   | CalendarLib.Date.Mon -> "monday"

     

       297
       +
                   | CalendarLib.Date.Tue -> "tuesday"

     

       298
       +
                   | CalendarLib.Date.Wed -> "wednesday"

     

       299
       +
                   | CalendarLib.Date.Thu -> "thursday"

     

       300
       +
                   | CalendarLib.Date.Fri -> "friday"

     

       301
       +
                   | CalendarLib.Date.Sat -> "saturday"

     

       302
       +
                   | CalendarLib.Date.Sun -> "sunday"

     

       303
       +
                 in

     

       304
       +
                 ( Printf.sprintf "(%04d %02d %02d %s)" y m d dow,

     

       305
       +
                   Printf.sprintf "(%02d %02d %02d)" h min s )

     

       306
       +
               in

     

       307
       +
               let end_str =

     

       308
       +
                 match i.Recur.end_ with

     

       309
       +
                 | Some end_date ->

     

       310
       +
                     let y, m, d = Ptime.to_date end_date in

     

       311
       +
                     let _, ((h, min, s), _) = Ptime.to_date_time end_date in

     

       312
       +
                     let cal_date = CalendarLib.Date.make y m d in

     

       313
       +
                     let dow =

     

       314
       +
                       match CalendarLib.Date.day_of_week cal_date with

     

       315
       +
                       | CalendarLib.Date.Mon -> "monday"

     

       316
       +
                       | CalendarLib.Date.Tue -> "tuesday"

     

       317
       +
                       | CalendarLib.Date.Wed -> "wednesday"

     

       318
       +
                       | CalendarLib.Date.Thu -> "thursday"

     

       319
       +
                       | CalendarLib.Date.Fri -> "friday"

     

       320
       +
                       | CalendarLib.Date.Sat -> "saturday"

     

       321
       +
                       | CalendarLib.Date.Sun -> "sunday"

     

       322
       +
                     in

     

       323
       +
                     Printf.sprintf "((%04d %02d %02d %s) (%02d %02d %02d))" y m d dow

     

       324
       +
                       h min s

     

       325
       +
                 | None -> "nil"

     

       326
       +
               in

     

       327
       +
               let location =

     

       328
       +
                 match Event.get_location e with

     

       329
       +
                 | Some loc -> Printf.sprintf "\"%s\"" (String.escaped loc)

     

       330
       +
                 | None -> "nil"

     

       331
       +
               in

     

       332
       +
               let description =

     

       333
       +
                 match Event.get_description e with

     

       334
       +
                 | Some desc -> Printf.sprintf "\"%s\"" (String.escaped desc)

     

       335
       +
                 | None -> "nil"

     

       336
       +
               in

     

       337
       +
               let calendar =

     

       338
       +
                 match Event.get_collection e with

     

       339
       +
                 | Some (Calendar_dir.Collection cal) ->

     

       340
       +
                     Printf.sprintf "\"%s\"" (String.escaped cal)

     

       341
       +
                 | None -> "nil"

     

       342
       +
               in

     

       343
       +
               let id = Event.get_id e in

     

       344
       +
               Printf.sprintf

     

       345
       +
                 "((:id \"%s\" :summary \"%s\" :start (%s %s) :end %s :location %s \

     

       346
       +
                  :description %s :calendar %s))"

     

       347
       +
                 (String.escaped id) (String.escaped summary) start_date start_time

     

       348
       +
                 end_str location description calendar

     

       349
       +
             in

     

       350
       +
             "(" ^ String.concat "\n " (List.map format_instance_sexp instances) ^ ")"

     

       351
       +
         | _ ->

     

       352
       +
             String.concat "\n"

     

       353
       +
               (List.map (fun i -> format_instance ~format i) instances)

+17

lib/format.mli

···

       1
       +
       (** Functions for formatting various data structures as strings *)

     

       2
       +
       

     

       3
       +
       type format = [ `Text | `Json | `Csv | `Ics | `Table | `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 *)

+424

lib/query.ml

···

       1
       +
       type filter =

     

       2
       +
         | SummaryContains of string

     

       3
       +
         | DescriptionContains of string

     

       4
       +
         | LocationContains of string

     

       5
       +
         | InCollections of Calendar_dir.collection 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 calendar_to_ptime date =

     

       17
       +
         let open CalendarLib in

     

       18
       +
         let year = Calendar.year date in

     

       19
       +
         let month = Date.int_of_month (Calendar.month date) in

     

       20
       +
         let day = Calendar.day_of_month date in

     

       21
       +
         let time = Calendar.to_time date in

     

       22
       +
         let hour = Time.hour time in

     

       23
       +
         let minute = Time.minute time in

     

       24
       +
         let second = Time.second time in

     

       25
       +
         match

     

       26
       +
           Ptime.of_date_time ((year, month, day), ((hour, minute, second), 0))

     

       27
       +
         with

     

       28
       +
         | Some t -> t

     

       29
       +
         | None -> failwith "Invalid date conversion from Calendar to Ptime"

     

       30
       +
       

     

       31
       +
       let ptime_to_calendar ptime =

     

       32
       +
         let (year, month, day), ((hour, minute, second), _) =

     

       33
       +
           Ptime.to_date_time ptime

     

       34
       +
         in

     

       35
       +
         let open CalendarLib in

     

       36
       +
         let date = Date.make year month day in

     

       37
       +
         let time = Time.make hour minute second in

     

       38
       +
         Calendar.create date time

     

       39
       +
       

     

       40
       +
       let get_today =

     

       41
       +
         ref (fun () ->

     

       42
       +
             let today_date = CalendarLib.Date.today () in

     

       43
       +
             let midnight = CalendarLib.Time.make 0 0 0 in

     

       44
       +
             let today_with_midnight =

     

       45
       +
               CalendarLib.Calendar.create today_date midnight

     

       46
       +
             in

     

       47
       +
             calendar_to_ptime today_with_midnight)

     

       48
       +
       

     

       49
       +
       (* Convert a midnight timestamp to end-of-day (23:59:59) *)

     

       50
       +
       let to_end_of_day date =

     

       51
       +
         let cal_date = ptime_to_calendar date in

     

       52
       +
         let date_only = CalendarLib.Calendar.to_date cal_date in

     

       53
       +
         let end_of_day_time = CalendarLib.Time.make 23 59 59 in

     

       54
       +
         let end_of_day = CalendarLib.Calendar.create date_only end_of_day_time in

     

       55
       +
         calendar_to_ptime end_of_day

     

       56
       +
       

     

       57
       +
       let add_days date days =

     

       58
       +
         let cal_date = ptime_to_calendar date in

     

       59
       +
         let period = CalendarLib.Calendar.Period.day days in

     

       60
       +
         let new_date = CalendarLib.Calendar.add cal_date period in

     

       61
       +
         calendar_to_ptime new_date

     

       62
       +
       

     

       63
       +
       let add_weeks date weeks =

     

       64
       +
         let cal_date = ptime_to_calendar date in

     

       65
       +
         let period = CalendarLib.Calendar.Period.week weeks in

     

       66
       +
         let new_date = CalendarLib.Calendar.add cal_date period in

     

       67
       +
         calendar_to_ptime new_date

     

       68
       +
       

     

       69
       +
       let add_months date months =

     

       70
       +
         let cal_date = ptime_to_calendar date in

     

       71
       +
         let period = CalendarLib.Calendar.Period.month months in

     

       72
       +
         let new_date = CalendarLib.Calendar.add cal_date period in

     

       73
       +
         calendar_to_ptime new_date

     

       74
       +
       

     

       75
       +
       let add_years date years =

     

       76
       +
         let cal_date = ptime_to_calendar date in

     

       77
       +
         let period = CalendarLib.Calendar.Period.year years in

     

       78
       +
         let new_date = CalendarLib.Calendar.add cal_date period in

     

       79
       +
         calendar_to_ptime new_date

     

       80
       +
       

     

       81
       +
       let get_start_of_week date =

     

       82
       +
         let cal_date = ptime_to_calendar date in

     

       83
       +
         let day_of_week = CalendarLib.Calendar.day_of_week cal_date in

     

       84
       +
         let days_to_subtract =

     

       85
       +
           match day_of_week with

     

       86
       +
           | CalendarLib.Date.Mon -> 0

     

       87
       +
           | CalendarLib.Date.Tue -> 1

     

       88
       +
           | CalendarLib.Date.Wed -> 2

     

       89
       +
           | CalendarLib.Date.Thu -> 3

     

       90
       +
           | CalendarLib.Date.Fri -> 4

     

       91
       +
           | CalendarLib.Date.Sat -> 5

     

       92
       +
           | CalendarLib.Date.Sun -> 6

     

       93
       +
         in

     

       94
       +
         let monday =

     

       95
       +
           CalendarLib.Calendar.add cal_date

     

       96
       +
             (CalendarLib.Calendar.Period.day (-days_to_subtract))

     

       97
       +
         in

     

       98
       +
         (* Extract the date part and create a new calendar with midnight time *)

     

       99
       +
         let monday_date = CalendarLib.Calendar.to_date monday in

     

       100
       +
         let midnight = CalendarLib.Time.make 0 0 0 in

     

       101
       +
         let monday_at_midnight = CalendarLib.Calendar.create monday_date midnight in

     

       102
       +
         calendar_to_ptime monday_at_midnight

     

       103
       +
       

     

       104
       +
       let get_start_of_current_week () = get_start_of_week (!get_today ())

     

       105
       +
       let get_start_of_next_week () = add_days (get_start_of_current_week ()) 7

     

       106
       +
       let get_end_of_week date = add_days (get_start_of_week date) 6

     

       107
       +
       let get_end_of_current_week () = get_end_of_week (!get_today ())

     

       108
       +
       let get_end_of_next_week () = get_end_of_week (get_start_of_next_week ())

     

       109
       +
       

     

       110
       +
       let get_start_of_month date =

     

       111
       +
         let cal_date = ptime_to_calendar date in

     

       112
       +
         (* Extract year and month from calendar date *)

     

       113
       +
         let year = CalendarLib.Calendar.year cal_date in

     

       114
       +
         let month = CalendarLib.Calendar.month cal_date in

     

       115
       +
         (* Create a date for the first of the month *)

     

       116
       +
         let month_int = CalendarLib.Date.int_of_month month in

     

       117
       +
         let first_day = CalendarLib.Date.make year month_int 1 in

     

       118
       +
         let midnight = CalendarLib.Time.make 0 0 0 in

     

       119
       +
         let first_of_month = CalendarLib.Calendar.create first_day midnight in

     

       120
       +
         calendar_to_ptime first_of_month

     

       121
       +
       

     

       122
       +
       let get_start_of_current_month () = get_start_of_month (!get_today ())

     

       123
       +
       let get_start_of_next_month () = add_months (get_start_of_current_month ()) 1

     

       124
       +
       

     

       125
       +
       let get_end_of_month date =

     

       126
       +
         let cal_date = ptime_to_calendar date in

     

       127
       +
         let year = CalendarLib.Calendar.year cal_date in

     

       128
       +
         let month = CalendarLib.Calendar.month cal_date in

     

       129
       +
         let month_int = CalendarLib.Date.int_of_month month in

     

       130
       +
         (* Create a calendar for the first of next month *)

     

       131
       +
         let next_month_int = if month_int == 12 then 1 else month_int + 1 in

     

       132
       +
         let next_month_year = if month_int == 12 then year + 1 else year in

     

       133
       +
         let first_of_next_month =

     

       134
       +
           CalendarLib.Date.make next_month_year next_month_int 1

     

       135
       +
         in

     

       136
       +
         let midnight = CalendarLib.Time.make 0 0 0 in

     

       137
       +
         let first_of_next_month_cal =

     

       138
       +
           CalendarLib.Calendar.create first_of_next_month midnight

     

       139
       +
         in

     

       140
       +
         (* Subtract one second to get the end of the current month *)

     

       141
       +
         let period = CalendarLib.Calendar.Period.second (-1) in

     

       142
       +
         let last_of_month = CalendarLib.Calendar.add first_of_next_month_cal period in

     

       143
       +
         calendar_to_ptime last_of_month

     

       144
       +
       

     

       145
       +
       let get_end_of_current_month () = get_end_of_month (!get_today ())

     

       146
       +
       let get_end_of_next_month () = get_end_of_month (get_start_of_next_month ())

     

       147
       +
       

     

       148
       +
       (* Parse a date string that could be ISO format or a relative expression *)

     

       149
       +
       let parse_date_expression expr parameter =

     

       150
       +
         let iso_date_regex = Re.Pcre.regexp "^(\\d{4})-(\\d{2})-(\\d{2})$" in

     

       151
       +
         let relative_regex = Re.Pcre.regexp "^([+-])(\\d+)([dwm])$" in

     

       152
       +
         match expr with

     

       153
       +
         | "today" -> !get_today ()

     

       154
       +
         | "tomorrow" -> add_days (!get_today ()) 1

     

       155
       +
         | "yesterday" -> add_days (!get_today ()) (-1)

     

       156
       +
         | "this-week" -> (

     

       157
       +
             match parameter with

     

       158
       +
             | `From -> get_start_of_current_week ()

     

       159
       +
             | `To -> get_end_of_current_week ())

     

       160
       +
         | "next-week" -> (

     

       161
       +
             match parameter with

     

       162
       +
             | `From -> get_start_of_next_week ()

     

       163
       +
             | `To -> get_end_of_next_week ())

     

       164
       +
         | "this-month" -> (

     

       165
       +
             match parameter with

     

       166
       +
             | `From -> get_start_of_current_month ()

     

       167
       +
             | `To -> get_end_of_current_month ())

     

       168
       +
         | "next-month" -> (

     

       169
       +
             match parameter with

     

       170
       +
             | `From -> get_start_of_next_month ()

     

       171
       +
             | `To -> get_end_of_next_month ())

     

       172
       +
         | _ ->

     

       173
       +
             (* Try to parse as ISO date *)

     

       174
       +
             if Re.Pcre.pmatch ~rex:iso_date_regex expr then

     

       175
       +
               try

     

       176
       +
                 let year =

     

       177
       +
                   int_of_string

     

       178
       +
                     (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 1)

     

       179
       +
                 in

     

       180
       +
                 let month =

     

       181
       +
                   int_of_string

     

       182
       +
                     (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 2)

     

       183
       +
                 in

     

       184
       +
                 let day =

     

       185
       +
                   int_of_string

     

       186
       +
                     (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 3)

     

       187
       +
                 in

     

       188
       +
                 match Ptime.of_date_time ((year, month, day), ((0, 0, 0), 0)) with

     

       189
       +
                 | Some date -> date

     

       190
       +
                 | None -> failwith (Printf.sprintf "Invalid date: %s" expr)

     

       191
       +
               with e ->

     

       192
       +
                 failwith

     

       193
       +
                   (Printf.sprintf "Failed to parse ISO date '%s': %s" expr

     

       194
       +
                      (Printexc.to_string e))

     

       195
       +
               (* Try to parse as relative expression +Nd, -Nd, etc. *)

     

       196
       +
             else if Re.Pcre.pmatch ~rex:relative_regex expr then

     

       197
       +
               try

     

       198
       +
                 let sign =

     

       199
       +
                   Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 1

     

       200
       +
                 in

     

       201
       +
                 let num =

     

       202
       +
                   int_of_string

     

       203
       +
                     (Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 2)

     

       204
       +
                 in

     

       205
       +
                 let unit =

     

       206
       +
                   Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 3

     

       207
       +
                 in

     

       208
       +
                 let multiplier = if sign = "+" then 1 else -1 in

     

       209
       +
                 let value = num * multiplier in

     

       210
       +
                 let today = !get_today () in

     

       211
       +
                 match unit with

     

       212
       +
                 | "d" -> add_days today value

     

       213
       +
                 | "w" -> (

     

       214
       +
                     let date = add_weeks today value in

     

       215
       +
                     match parameter with

     

       216
       +
                     | `From -> get_start_of_week date

     

       217
       +
                     | `To -> get_end_of_week date)

     

       218
       +
                 | "m" -> (

     

       219
       +
                     let date = add_months today value in

     

       220
       +
                     match parameter with

     

       221
       +
                     | `From -> get_start_of_month date

     

       222
       +
                     | `To -> get_end_of_month date)

     

       223
       +
                 | _ -> failwith (Printf.sprintf "Invalid date unit: %s" unit)

     

       224
       +
               with e ->

     

       225
       +
                 failwith

     

       226
       +
                   (Printf.sprintf "Failed to parse relative date '%s': %s" expr

     

       227
       +
                      (Printexc.to_string e))

     

       228
       +
             else failwith (Printf.sprintf "Invalid date format: %s" expr)

     

       229
       +
       

     

       230
       +
       let convert_relative_date_formats ~today ~tomorrow ~week ~month =

     

       231
       +
         if today then

     

       232
       +
           let today_date = !get_today () in

     

       233
       +
           (* Set the end date to end-of-day to include all events on that day *)

     

       234
       +
           let end_of_today = to_end_of_day today_date in

     

       235
       +
           Some (today_date, end_of_today)

     

       236
       +
         else if tomorrow then

     

       237
       +
           let today = !get_today () in

     

       238
       +
           let tomorrow_date = add_days today 1 in

     

       239
       +
           (* Set the end date to end-of-day to include all events on that day *)

     

       240
       +
           let end_of_tomorrow = to_end_of_day tomorrow_date in

     

       241
       +
           Some (tomorrow_date, end_of_tomorrow)

     

       242
       +
         else if week then

     

       243
       +
           let week_start = get_start_of_current_week () in

     

       244
       +
           let week_end_date = add_days week_start 6 in

     

       245
       +
           (* Sunday is 6 days from Monday *)

     

       246
       +
           (* Set the end date to end-of-day to include all events on Sunday *)

     

       247
       +
           let end_of_week = to_end_of_day week_end_date in

     

       248
       +
           Some (week_start, end_of_week)

     

       249
       +
         else if month then

     

       250
       +
           let month_start = get_start_of_current_month () in

     

       251
       +
           let month_end = get_end_of_month month_start in

     

       252
       +
           Some (month_start, month_end)

     

       253
       +
         else None

     

       254
       +
       

     

       255
       +
       let summary_contains text = SummaryContains text

     

       256
       +
       let description_contains text = DescriptionContains text

     

       257
       +
       let location_contains text = LocationContains text

     

       258
       +
       let in_collections ids = InCollections ids

     

       259
       +
       let recurring_only () = RecurringOnly

     

       260
       +
       let non_recurring_only () = NonRecurringOnly

     

       261
       +
       let with_id id = WithId id

     

       262
       +
       let and_filter filters = And filters

     

       263
       +
       let or_filter filters = Or filters

     

       264
       +
       let not_filter filter = Not filter

     

       265
       +
       

     

       266
       +
       let rec matches_filter event = function

     

       267
       +
         | SummaryContains text ->

     

       268
       +
             let summary = Event.get_summary event in

     

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

     

       270
       +
             Re.Pcre.pmatch ~rex:re summary

     

       271
       +
         | DescriptionContains text -> (

     

       272
       +
             match Event.get_description event with

     

       273
       +
             | Some desc ->

     

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

     

       275
       +
                 Re.Pcre.pmatch ~rex:re desc

     

       276
       +
             | None -> false)

     

       277
       +
         | LocationContains text -> (

     

       278
       +
             match Event.get_location event with

     

       279
       +
             | Some loc ->

     

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

     

       281
       +
                 Re.Pcre.pmatch ~rex:re loc

     

       282
       +
             | None -> false)

     

       283
       +
         | InCollections ids -> (

     

       284
       +
             match Event.get_collection event with

     

       285
       +
             | Some id -> List.exists (fun col -> col = id) ids

     

       286
       +
             | None -> false)

     

       287
       +
         | RecurringOnly -> Event.get_recurrence event <> None

     

       288
       +
         | NonRecurringOnly -> Event.get_recurrence event = None

     

       289
       +
         | WithId id -> Event.get_id event = id

     

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

     

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

     

       292
       +
         | Not filter -> not (matches_filter event filter)

     

       293
       +
       

     

       294
       +
       let compare_events sort_by order e1 e2 =

     

       295
       +
         let compare =

     

       296
       +
           match sort_by with

     

       297
       +
           | `Start ->

     

       298
       +
               let t1 = Event.get_start e1 in

     

       299
       +
               let t2 = Event.get_start e2 in

     

       300
       +
               Ptime.compare t1 t2

     

       301
       +
           | `End -> (

     

       302
       +
               match (Event.get_end e1, Event.get_end e2) with

     

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

     

       304
       +
               | Some _, None -> 1

     

       305
       +
               | None, Some _ -> -1

     

       306
       +
               | None, None -> 0)

     

       307
       +
           | `Summary -> String.compare (Event.get_summary e1) (Event.get_summary e2)

     

       308
       +
           | `Location -> (

     

       309
       +
               match (Event.get_location e1, Event.get_location e2) with

     

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

     

       311
       +
               | Some _, None -> 1

     

       312
       +
               | None, Some _ -> -1

     

       313
       +
               | None, None -> 0)

     

       314
       +
           | `Calendar -> (

     

       315
       +
               match (Event.get_collection e1, Event.get_collection e2) with

     

       316
       +
               | Some (Calendar_dir.Collection c1), Some (Calendar_dir.Collection c2)

     

       317
       +
                 ->

     

       318
       +
                   String.compare c1 c2

     

       319
       +
               | Some _, None -> 1

     

       320
       +
               | None, Some _ -> -1

     

       321
       +
               | None, None -> 0)

     

       322
       +
         in

     

       323
       +
         match order with `Ascending -> compare | `Descending -> -compare

     

       324
       +
       

     

       325
       +
       let get_all_events ~fs calendar_dir =

     

       326
       +
         match Calendar_dir.get_collections ~fs calendar_dir with

     

       327
       +
         | Ok collections ->

     

       328
       +
             let events =

     

       329
       +
               List.concat_map

     

       330
       +
                 (fun (collection, calendar_files) ->

     

       331
       +
                   List.concat_map

     

       332
       +
                     (fun calendar_file ->

     

       333
       +
                       List.filter_map

     

       334
       +
                         (function

     

       335
       +
                           | `Event e -> (

     

       336
       +
                               match Event.of_icalendar collection e with

     

       337
       +
                               | Ok event -> Some event

     

       338
       +
                               | Error (`Msg msg) ->

     

       339
       +
                                   Printf.eprintf "Error parsing event from %s: %s\n%!"

     

       340
       +
                                     calendar_file.Calendar_dir.file_path msg;

     

       341
       +
                                   None)

     

       342
       +
                           | _ -> None)

     

       343
       +
                         (snd calendar_file.Calendar_dir.calendar))

     

       344
       +
                     calendar_files)

     

       345
       +
                 collections

     

       346
       +
             in

     

       347
       +
             Ok events

     

       348
       +
         | Error e -> Error e

     

       349
       +
       

     

       350
       +
       let query_events ~fs calendar_dir ?filter ?sort_by ?order ?limit () =

     

       351
       +
         match get_all_events ~fs calendar_dir with

     

       352
       +
         | Ok events ->

     

       353
       +
             let filtered_events =

     

       354
       +
               match filter with

     

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

     

       356
       +
               | None -> events

     

       357
       +
             in

     

       358
       +
             let sorted_events =

     

       359
       +
               match (sort_by, order) with

     

       360
       +
               | Some criteria, Some ord ->

     

       361
       +
                   List.sort (compare_events criteria ord) filtered_events

     

       362
       +
               | Some criteria, None ->

     

       363
       +
                   List.sort (compare_events criteria `Ascending) filtered_events

     

       364
       +
               | None, _ ->

     

       365
       +
                   List.sort (compare_events `Start `Ascending) filtered_events

     

       366
       +
             in

     

       367
       +
             Ok

     

       368
       +
               (match limit with

     

       369
       +
               | Some n when n > 0 ->

     

       370
       +
                   let rec take n lst acc =

     

       371
       +
                     match (lst, n) with

     

       372
       +
                     | _, 0 -> List.rev acc

     

       373
       +
                     | [], _ -> List.rev acc

     

       374
       +
                     | x :: xs, n -> take (n - 1) xs (x :: acc)

     

       375
       +
                   in

     

       376
       +
                   take n sorted_events []

     

       377
       +
               | _ -> sorted_events)

     

       378
       +
         | Error e -> Error e

     

       379
       +
       

     

       380
       +
       let query ~fs calendar_dir ?filter ~from ~to_ ?sort_by ?order ?limit () =

     

       381
       +
         match query_events ~fs calendar_dir ?filter ?sort_by ?order () with

     

       382
       +
         | Ok events ->

     

       383
       +
             let instances =

     

       384
       +
               List.concat_map

     

       385
       +
                 (fun event -> Recur.expand_event event ~from ~to_)

     

       386
       +
                 events

     

       387
       +
             in

     

       388
       +
             let compare_instances criteria ord i1 i2 =

     

       389
       +
               match criteria with

     

       390
       +
               | `Start ->

     

       391
       +
                   let c = Ptime.compare i1.Recur.start i2.Recur.start in

     

       392
       +
                   if ord = `Ascending then c else -c

     

       393
       +
               | `End -> (

     

       394
       +
                   match (i1.Recur.end_, i2.Recur.end_) with

     

       395
       +
                   | Some t1, Some t2 ->

     

       396
       +
                       let c = Ptime.compare t1 t2 in

     

       397
       +
                       if ord = `Ascending then c else -c

     

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

     

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

     

       400
       +
                   | None, None -> 0)

     

       401
       +
               | other ->

     

       402
       +
                   let c = compare_events other ord i1.Recur.event i2.Recur.event in

     

       403
       +
                   if ord = `Ascending then c else -c

     

       404
       +
             in

     

       405
       +
             let sorted_instances =

     

       406
       +
               match (sort_by, order) with

     

       407
       +
               | Some criteria, Some ord ->

     

       408
       +
                   List.sort (compare_instances criteria ord) instances

     

       409
       +
               | Some criteria, None ->

     

       410
       +
                   List.sort (compare_instances criteria `Ascending) instances

     

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

     

       412
       +
             in

     

       413
       +
             Ok

     

       414
       +
               (match limit with

     

       415
       +
               | Some n when n > 0 ->

     

       416
       +
                   let rec take n lst acc =

     

       417
       +
                     match (lst, n) with

     

       418
       +
                     | _, 0 -> List.rev acc

     

       419
       +
                     | [], _ -> List.rev acc

     

       420
       +
                     | x :: xs, n -> take (n - 1) xs (x :: acc)

     

       421
       +
                   in

     

       422
       +
                   take n sorted_instances []

     

       423
       +
               | _ -> sorted_instances)

     

       424
       +
         | Error e -> Error e

+152

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
       +
       (** {1 Date helper functions} *)

     

       13
       +
       

     

       14
       +
       val get_today : (unit -> Ptime.t) ref

     

       15
       +
       (** Get the current date at midnight. This is a reference to support testing.

     

       16
       +
           Returns the date or raises an exception if the date cannot be determined. *)

     

       17
       +
       

     

       18
       +
       val to_end_of_day : Ptime.t -> Ptime.t

     

       19
       +
       (** Converts a date with midnight time (00:00:00) to the same date with

     

       20
       +
           end-of-day time (23:59:59). This is particularly useful for making "to"

     

       21
       +
           dates in a range inclusive, addressing the common UX expectation that

     

       22
       +
           specifying "--to 2025-04-01" would include events occurring on April 1st. *)

     

       23
       +
       

     

       24
       +
       val add_days : Ptime.t -> int -> Ptime.t

     

       25
       +
       (** Add specified number of days to a date. Raises an exception if the date

     

       26
       +
           cannot be calculated. *)

     

       27
       +
       

     

       28
       +
       val add_weeks : Ptime.t -> int -> Ptime.t

     

       29
       +
       (** Add specified number of weeks to a date. Raises an exception if the date

     

       30
       +
           cannot be calculated. *)

     

       31
       +
       

     

       32
       +
       val add_months : Ptime.t -> int -> Ptime.t

     

       33
       +
       (** Add specified number of months to a date. Raises an exception if the date

     

       34
       +
           cannot be calculated. *)

     

       35
       +
       

     

       36
       +
       val add_years : Ptime.t -> int -> Ptime.t

     

       37
       +
       (** Add specified number of months to a date. Raises an exception if the date

     

       38
       +
           cannot be calculated. *)

     

       39
       +
       

     

       40
       +
       val get_start_of_week : Ptime.t -> Ptime.t

     

       41
       +
       (** Get the start of the week (Monday) for the given date. Raises an exception

     

       42
       +
           if the date cannot be calculated. *)

     

       43
       +
       

     

       44
       +
       val get_start_of_current_week : unit -> Ptime.t

     

       45
       +
       (** Get the start of the current week. Raises an exception if the date cannot be

     

       46
       +
           calculated. *)

     

       47
       +
       

     

       48
       +
       val get_start_of_next_week : unit -> Ptime.t

     

       49
       +
       (** Get the start of next week. Raises an exception if the date cannot be

     

       50
       +
           calculated. *)

     

       51
       +
       

     

       52
       +
       val get_end_of_week : Ptime.t -> Ptime.t

     

       53
       +
       (** Get the end of the week (Monday) for the given date. Raises an exception if

     

       54
       +
           the date cannot be calculated. *)

     

       55
       +
       

     

       56
       +
       val get_end_of_current_week : unit -> Ptime.t

     

       57
       +
       (** Get the end of the current week. Raises an exception if the date cannot be

     

       58
       +
           calculated. *)

     

       59
       +
       

     

       60
       +
       val get_end_of_next_week : unit -> Ptime.t

     

       61
       +
       (** Get the end of next week. Raises an exception if the date cannot be

     

       62
       +
           calculated. *)

     

       63
       +
       

     

       64
       +
       val get_start_of_month : Ptime.t -> Ptime.t

     

       65
       +
       (** Get the start of the month for the given date. Raises an exception if the

     

       66
       +
           date cannot be calculated. *)

     

       67
       +
       

     

       68
       +
       val get_start_of_current_month : unit -> Ptime.t

     

       69
       +
       (** Get the start of the current month. Raises an exception if the date cannot

     

       70
       +
           be calculated. *)

     

       71
       +
       

     

       72
       +
       val get_start_of_next_month : unit -> Ptime.t

     

       73
       +
       (** Get the start of next month. Raises an exception if the date cannot be

     

       74
       +
           calculated. *)

     

       75
       +
       

     

       76
       +
       val get_end_of_current_month : unit -> Ptime.t

     

       77
       +
       (** Get the end of the current month. Raises an exception if the date cannot be

     

       78
       +
           calculated. *)

     

       79
       +
       

     

       80
       +
       val get_end_of_next_month : unit -> Ptime.t

     

       81
       +
       (** Get the end of next month. Raises an exception if the date cannot be

     

       82
       +
           calculated. *)

     

       83
       +
       

     

       84
       +
       val get_end_of_month : Ptime.t -> Ptime.t

     

       85
       +
       (** Get the end of the month for the given date. Raises an exception if the date

     

       86
       +
           cannot be calculated. *)

     

       87
       +
       

     

       88
       +
       val parse_date_expression : string -> [ `To | `From ] -> Ptime.t

     

       89
       +
       (** Parse a date string that could be ISO format (YYYY-MM-DD) or a relative

     

       90
       +
           expression. Raises an exception if the date cannot be parsed.

     

       91
       +
       

     

       92
       +
           Supported formats:

     

       93
       +
           - ISO format: "YYYY-MM-DD"

     

       94
       +
           - Relative expressions:

     

       95
       +
           - "today" - Current day

     

       96
       +
           - "tomorrow" - Next day

     

       97
       +
           - "yesterday" - Previous day

     

       98
       +
           - "this-week" - Start of current week

     

       99
       +
           - "next-week" - Start of next week

     

       100
       +
           - "this-month" - Start of current month

     

       101
       +
           - "next-month" - Start of next month

     

       102
       +
           - "+Nd" - N days from today (e.g., "+7d" for a week from today)

     

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

     

       104
       +
           - "+Nw" - N weeks from today

     

       105
       +
           - "+Nm" - N months from today *)

     

       106
       +
       

     

       107
       +
       val convert_relative_date_formats :

     

       108
       +
         today:bool ->

     

       109
       +
         tomorrow:bool ->

     

       110
       +
         week:bool ->

     

       111
       +
         month:bool ->

     

       112
       +
         (Ptime.t * Ptime.t) option

     

       113
       +
       (** Converts relative date formats to determine from/to_ dates. Returns a tuple

     

       114
       +
           of (start_date, end_date) or raises an exception if the dates could not be

     

       115
       +
           determined. **)

     

       116
       +
       

     

       117
       +
       (** {1 Filter creation} *)

     

       118
       +
       

     

       119
       +
       val summary_contains : string -> filter

     

       120
       +
       val description_contains : string -> filter

     

       121
       +
       val location_contains : string -> filter

     

       122
       +
       val in_collections : Calendar_dir.collection list -> filter

     

       123
       +
       val recurring_only : unit -> filter

     

       124
       +
       val non_recurring_only : unit -> filter

     

       125
       +
       val with_id : Event.event_id -> filter

     

       126
       +
       

     

       127
       +
       val and_filter : filter list -> filter

     

       128
       +
       (** Filter composition *)

     

       129
       +
       

     

       130
       +
       val or_filter : filter list -> filter

     

       131
       +
       val not_filter : filter -> filter

     

       132
       +
       

     

       133
       +
       val query :

     

       134
       +
         fs:[> Eio.Fs.dir_ty ] Eio.Path.t ->

     

       135
       +
         Calendar_dir.calendar_dir ->

     

       136
       +
         ?filter:filter ->

     

       137
       +
         from:Ptime.t option ->

     

       138
       +
         to_:Ptime.t ->

     

       139
       +
         ?sort_by:sort_by ->

     

       140
       +
         ?order:sort_order ->

     

       141
       +
         ?limit:int ->

     

       142
       +
         unit ->

     

       143
       +
         (Recur.instance list, [> `Msg of string ]) result

     

       144
       +
       (** Find events with expansion of recurring events. Returns Ok with the list of

     

       145
       +
           instances, or Error with a message. *)

     

       146
       +
       

     

       147
       +
       (* Test-only helper functions *)

     

       148
       +
       val matches_filter : Event.t -> filter -> bool

     

       149
       +
       (** Check if an event matches the given filter *)

     

       150
       +
       

     

       151
       +
       val compare_events : sort_by -> sort_order -> Event.t -> Event.t -> int

     

       152
       +
       (** Compare two events based on the sort criteria and order *)

+42

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
       +
             let start = Event.get_start event in

     

       18
       +
             (* Include the original event instance only if it falls within the query range *)

     

       19
       +
             if

     

       20
       +
               Ptime.compare start to_ <= 0

     

       21
       +
               && match from with Some f -> Ptime.compare start f >= 0 | None -> true

     

       22
       +
             then [ clone_with_time event start ]

     

       23
       +
             else []

     

       24
       +
         (* We return all instances within the range, regardless of whether the original

     

       25
       +
            event instance was included. This ensures recurring events that start before

     

       26
       +
            the query range but have instances within it are properly included. *)

     

       27
       +
         | Some rule ->

     

       28
       +
             let rec collect generator acc =

     

       29
       +
               match generator () with

     

       30
       +
               | None -> List.rev acc

     

       31
       +
               | Some date ->

     

       32
       +
                   if Ptime.compare date to_ > 0 then List.rev acc

     

       33
       +
                   else if

     

       34
       +
                     match from with

     

       35
       +
                     | Some f -> Ptime.compare date f < 0

     

       36
       +
                     | None -> false

     

       37
       +
                   then collect generator acc

     

       38
       +
                   else collect generator (clone_with_time event date :: acc)

     

       39
       +
             in

     

       40
       +
             let start_date = Event.get_start event in

     

       41
       +
             let generator = recur_dates start_date rule in

     

       42
       +
             collect generator []

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. *)

+13

test/calendar/example/event.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:test-event@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250327T090000Z

     

       8
       +
       DTEND:20250327T100000Z

     

       9
       +
       SUMMARY:Test Event

     

       10
       +
       LOCATION:Test Location

     

       11
       +
       DESCRIPTION:This is a test event for testing the Caledonia calendar library.

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/example/other-event.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:other-test-event@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250329T090000Z

     

       8
       +
       DTEND:20250329T100000Z

     

       9
       +
       SUMMARY:Other Test Event

     

       10
       +
       LOCATION:Test Location

     

       11
       +
       DESCRIPTION:This is a test event for testing the Caledonia calendar library.

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+14

test/calendar/recurrence/10_weekly_count10.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:weekly-count10-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250317T120000Z

     

       8
       +
       DTEND:20250317T130000Z

     

       9
       +
       SUMMARY:Recurring Event

     

       10
       +
       LOCATION:Weekly Meeting Room

     

       11
       +
       DESCRIPTION:Weekly event that repeats exactly 10 times

     

       12
       +
       RRULE:FREQ=WEEKLY;COUNT=10

     

       13
       +
       END:VEVENT

     

       14
       +
       END:VCALENDAR

+13

test/calendar/recurrence/11_daily_until.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:daily-until-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T100000Z

     

       8
       +
       DTEND:20250501T110000Z

     

       9
       +
       SUMMARY:Daily Until May 15

     

       10
       +
       DESCRIPTION:Daily event that repeats until a specific date

     

       11
       +
       RRULE:FREQ=DAILY;UNTIL=20250515T000000Z

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/12_weekly_until.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:weekly-until-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T120000Z

     

       8
       +
       DTEND:20250501T130000Z

     

       9
       +
       SUMMARY:Weekly Until June 30

     

       10
       +
       DESCRIPTION:Weekly event that repeats until a specific date

     

       11
       +
       RRULE:FREQ=WEEKLY;UNTIL=20250630T000000Z

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/13_weekly_monday_wednesday.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:weekly-mon-wed-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250324T140000Z

     

       8
       +
       DTEND:20250324T150000Z

     

       9
       +
       SUMMARY:Weekly on Monday and Wednesday

     

       10
       +
       DESCRIPTION:Weekly event that occurs on Monday and Wednesday

     

       11
       +
       RRULE:FREQ=WEEKLY;BYDAY=MO,WE

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/14_weekly_weekends.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:weekly-weekends-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T160000Z

     

       8
       +
       DTEND:20250501T170000Z

     

       9
       +
       SUMMARY:Weekly on Weekends

     

       10
       +
       DESCRIPTION:Weekly event that occurs on Saturday and Sunday

     

       11
       +
       RRULE:FREQ=WEEKLY;BYDAY=SA,SU

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/15_monthly_specific_day.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:monthly-15th-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250515T100000Z

     

       8
       +
       DTEND:20250515T110000Z

     

       9
       +
       SUMMARY:Monthly on the 15th

     

       10
       +
       DESCRIPTION:Monthly event occurring on the 15th of each month

     

       11
       +
       RRULE:FREQ=MONTHLY;BYMONTHDAY=15

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/16_monthly_second_monday.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:monthly-2nd-monday-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250513T120000Z

     

       8
       +
       DTEND:20250513T130000Z

     

       9
       +
       SUMMARY:Monthly on Second Monday

     

       10
       +
       DESCRIPTION:Monthly event occurring on the second Monday of each month

     

       11
       +
       RRULE:FREQ=MONTHLY;BYDAY=2MO

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/17_monthly_last_day.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:monthly-last-day-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250531T140000Z

     

       8
       +
       DTEND:20250531T150000Z

     

       9
       +
       SUMMARY:Monthly on Last Day

     

       10
       +
       DESCRIPTION:Monthly event occurring on the last day of each month

     

       11
       +
       RRULE:FREQ=MONTHLY;BYMONTHDAY=-1

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/18_yearly_specific_date.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:yearly-april15-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250415T160000Z

     

       8
       +
       DTEND:20250415T170000Z

     

       9
       +
       SUMMARY:Yearly on April 15

     

       10
       +
       DESCRIPTION:Yearly event occurring on April 15th each year

     

       11
       +
       RRULE:FREQ=YEARLY;BYMONTH=4;BYMONTHDAY=15

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/19_yearly_mothers_day.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:yearly-mothers-day-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250512T100000Z

     

       8
       +
       DTEND:20250512T110000Z

     

       9
       +
       SUMMARY:Mother's Day (2nd Sunday in May)

     

       10
       +
       DESCRIPTION:Yearly event on the second Sunday in May (Mother's Day in the US)

     

       11
       +
       RRULE:FREQ=YEARLY;BYMONTH=5;BYDAY=2SU

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/1_daily.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:daily-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250327T100000Z

     

       8
       +
       DTEND:20250327T110000Z

     

       9
       +
       SUMMARY:Daily Recurring Event

     

       10
       +
       DESCRIPTION:Basic daily recurring event

     

       11
       +
       RRULE:FREQ=DAILY

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/20_complex_weekdays_months.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:complex-weekdays-months-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250507T120000Z

     

       8
       +
       DTEND:20250507T130000Z

     

       9
       +
       SUMMARY:Tuesday/Thursday in Summer

     

       10
       +
       DESCRIPTION:Weekly on Tuesday and Thursday, but only in Jun, Jul, Aug

     

       11
       +
       RRULE:FREQ=WEEKLY;BYDAY=TU,TH;BYMONTH=6,7,8

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/21_complex_multiple_monthdays.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:complex-monthdays-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T140000Z

     

       8
       +
       DTEND:20250501T150000Z

     

       9
       +
       SUMMARY:Monthly on 1st, 15th, Last Day

     

       10
       +
       DESCRIPTION:Monthly event occurring on 1st, 15th, and last day of each month

     

       11
       +
       RRULE:FREQ=MONTHLY;BYMONTHDAY=1,15,-1

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+15

test/calendar/recurrence/22_with_exdate.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:with-exdate-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T160000Z

     

       8
       +
       DTEND:20250501T170000Z

     

       9
       +
       SUMMARY:Weekly with Exclusions

     

       10
       +
       DESCRIPTION:Weekly event with specific dates excluded

     

       11
       +
       RRULE:FREQ=WEEKLY

     

       12
       +
       EXDATE:20250515T160000Z

     

       13
       +
       EXDATE:20250529T160000Z

     

       14
       +
       END:VEVENT

     

       15
       +
       END:VCALENDAR

+13

test/calendar/recurrence/23_dst_transition.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:dst-transition-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20251027T010000Z

     

       8
       +
       DTEND:20251027T020000Z

     

       9
       +
       SUMMARY:Weekly over DST Transition

     

       10
       +
       DESCRIPTION:Weekly event that spans DST transition date

     

       11
       +
       RRULE:FREQ=WEEKLY;COUNT=4

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/24_long_interval.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:long-interval-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T080000Z

     

       8
       +
       DTEND:20250501T090000Z

     

       9
       +
       SUMMARY:Every 100 Days

     

       10
       +
       DESCRIPTION:Event that recurs every 100 days

     

       11
       +
       RRULE:FREQ=DAILY;INTERVAL=100

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/25_leap_day.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:leap-day-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20280229T090000Z

     

       8
       +
       DTEND:20280229T100000Z

     

       9
       +
       SUMMARY:Yearly on February 29

     

       10
       +
       DESCRIPTION:Yearly event on leap day (February 29)

     

       11
       +
       RRULE:FREQ=YEARLY;BYMONTH=2;BYMONTHDAY=29

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/26_weekly_wkst.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:weekly-wkst-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T080000Z

     

       8
       +
       DTEND:20250501T090000Z

     

       9
       +
       SUMMARY:Weekly with Monday Week Start

     

       10
       +
       DESCRIPTION:Weekly event with explicit week start day (Monday)

     

       11
       +
       RRULE:FREQ=WEEKLY;WKST=MO;COUNT=4

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/27_monthly_nth_weekday.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:monthly-third-sunday-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250519T090000Z

     

       8
       +
       DTEND:20250519T100000Z

     

       9
       +
       SUMMARY:Monthly on Third Sunday

     

       10
       +
       DESCRIPTION:Monthly event occurring on the third Sunday of each month

     

       11
       +
       RRULE:FREQ=MONTHLY;BYDAY=3SU

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/28_yearly_historical.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:yearly-historical-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20000101T100000Z

     

       8
       +
       DTEND:20000101T110000Z

     

       9
       +
       SUMMARY:Historical Yearly Series

     

       10
       +
       DESCRIPTION:Yearly events in the past, ending in 2010

     

       11
       +
       RRULE:FREQ=YEARLY;UNTIL=20101231T235959Z

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/29_monthly_bymonth.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:monthly-specific-months-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250301T110000Z

     

       8
       +
       DTEND:20250301T120000Z

     

       9
       +
       SUMMARY:Monthly in Mar, Jun, Sep, Dec

     

       10
       +
       DESCRIPTION:Monthly event occurring only in specific months of the year

     

       11
       +
       RRULE:FREQ=MONTHLY;BYMONTH=3,6,9,12

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/2_weekly.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:weekly-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250327T120000Z

     

       8
       +
       DTEND:20250327T130000Z

     

       9
       +
       SUMMARY:Weekly Recurring Event

     

       10
       +
       DESCRIPTION:Basic weekly recurring event

     

       11
       +
       RRULE:FREQ=WEEKLY

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/30_fourth_weekday.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:yearly-fourth-sunday-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20251027T120000Z

     

       8
       +
       DTEND:20251027T130000Z

     

       9
       +
       SUMMARY:Yearly on Fourth Sunday in October

     

       10
       +
       DESCRIPTION:Yearly event on the fourth Sunday in October

     

       11
       +
       RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=4SU

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/3_monthly.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:monthly-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T140000Z

     

       8
       +
       DTEND:20250501T150000Z

     

       9
       +
       SUMMARY:Monthly Recurring Event

     

       10
       +
       DESCRIPTION:Basic monthly recurring event

     

       11
       +
       RRULE:FREQ=MONTHLY

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/4_yearly.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:yearly-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T160000Z

     

       8
       +
       DTEND:20250501T170000Z

     

       9
       +
       SUMMARY:Yearly Recurring Event

     

       10
       +
       DESCRIPTION:Basic yearly recurring event

     

       11
       +
       RRULE:FREQ=YEARLY

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/5_every_2_days.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:every2days-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T100000Z

     

       8
       +
       DTEND:20250501T110000Z

     

       9
       +
       SUMMARY:Every 2 Days

     

       10
       +
       DESCRIPTION:Event recurring every 2 days with interval

     

       11
       +
       RRULE:FREQ=DAILY;INTERVAL=2

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/6_every_3_weeks.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:every3weeks-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T120000Z

     

       8
       +
       DTEND:20250501T130000Z

     

       9
       +
       SUMMARY:Every 3 Weeks

     

       10
       +
       DESCRIPTION:Event recurring every 3 weeks with interval

     

       11
       +
       RRULE:FREQ=WEEKLY;INTERVAL=3

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/7_bimonthly.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:bimonthly-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T140000Z

     

       8
       +
       DTEND:20250501T150000Z

     

       9
       +
       SUMMARY:Every Other Month

     

       10
       +
       DESCRIPTION:Event recurring every other month with interval

     

       11
       +
       RRULE:FREQ=MONTHLY;INTERVAL=2

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/8_biennial.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:biennial-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T160000Z

     

       8
       +
       DTEND:20250501T170000Z

     

       9
       +
       SUMMARY:Every 2 Years

     

       10
       +
       DESCRIPTION:Event recurring every 2 years with interval

     

       11
       +
       RRULE:FREQ=YEARLY;INTERVAL=2

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

+13

test/calendar/recurrence/9_daily_count5.ics

···

       1
       +
       BEGIN:VCALENDAR

     

       2
       +
       VERSION:2.0

     

       3
       +
       PRODID:-//Caledonia Test Suite//EN

     

       4
       +
       BEGIN:VEVENT

     

       5
       +
       UID:daily-count5-recur@caledonia.test

     

       6
       +
       DTSTAMP:20250329T000000Z

     

       7
       +
       DTSTART:20250501T100000Z

     

       8
       +
       DTEND:20250501T110000Z

     

       9
       +
       SUMMARY:Daily 5 Times

     

       10
       +
       DESCRIPTION:Daily event that repeats exactly 5 times

     

       11
       +
       RRULE:FREQ=DAILY;COUNT=5

     

       12
       +
       END:VEVENT

     

       13
       +
       END:VCALENDAR

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)))

+85

test/test_calendar_dir.ml

···

       1
       +
       (* Test the Calendar_dir.module *)

     

       2
       +
       

     

       3
       +
       open Caledonia_lib

     

       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);

     

       19
       +
             Alcotest.(check bool)

     

       20
       +
               "example should be in the list" true

     

       21
       +
               (List.exists

     

       22
       +
                  (fun c -> c = Calendar_dir.Collection "example")

     

       23
       +
                  collections);

     

       24
       +
             Alcotest.(check bool)

     

       25
       +
               "recurrence should be in the list" true

     

       26
       +
               (List.exists

     

       27
       +
                  (fun c -> c = Calendar_dir.Collection "recurrence")

     

       28
       +
                  collections);

     

       29
       +
             ()

     

       30
       +
       

     

       31
       +
       let test_get_collection ~fs () =

     

       32
       +
         let calendar_dir =

     

       33
       +
           match Calendar_dir.create ~fs calendar_dir_path with

     

       34
       +
           | Ok dir -> dir

     

       35
       +
           | Error (`Msg msg) ->

     

       36
       +
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       37
       +
         in

     

       38
       +
         let result =

     

       39
       +
           Calendar_dir.get_collection ~fs calendar_dir

     

       40
       +
             (Calendar_dir.Collection "example")

     

       41
       +
         in

     

       42
       +
         match result with

     

       43
       +
         | Ok _ -> Alcotest.(check pass) "Should find example collection" () ()

     

       44
       +
         | Error `Not_found -> Alcotest.fail "Failed to find example collection"

     

       45
       +
         | Error (`Msg msg) -> Alcotest.fail ("Error getting collection: " ^ msg)

     

       46
       +
       

     

       47
       +
       let test_get_collections ~fs () =

     

       48
       +
         let calendar_dir =

     

       49
       +
           match Calendar_dir.create ~fs calendar_dir_path with

     

       50
       +
           | Ok dir -> dir

     

       51
       +
           | Error (`Msg msg) ->

     

       52
       +
               Alcotest.fail ("Calendar directory creation failed: " ^ msg)

     

       53
       +
         in

     

       54
       +
         match Calendar_dir.get_collections ~fs calendar_dir with

     

       55
       +
         | Ok collections ->

     

       56
       +
             Alcotest.(check int)

     

       57
       +
               "Should find two collections" 2 (List.length collections);

     

       58
       +
             Alcotest.(check bool)

     

       59
       +
               "example should be in the results" true

     

       60
       +
               (List.exists

     

       61
       +
                  (fun (id, _) -> id = Calendar_dir.Collection "example")

     

       62
       +
                  collections);

     

       63
       +
             Alcotest.(check bool)

     

       64
       +
               "recurrence should be in the results" true

     

       65
       +
               (List.exists

     

       66
       +
                  (fun (id, _) -> id = Calendar_dir.Collection "recurrence")

     

       67
       +
                  collections);

     

       68
       +
             ()

     

       69
       +
         | Error e ->

     

       70
       +
             let msg =

     

       71
       +
               match e with `Msg m -> m | `Not_found -> "Collection not found"

     

       72
       +
             in

     

       73
       +
             Alcotest.fail ("Error getting collections: " ^ msg)

     

       74
       +
       

     

       75
       +
       let calendar_tests fs =

     

       76
       +
         [

     

       77
       +
           ("list collections", `Quick, test_list_collections ~fs);

     

       78
       +
           ("get collection", `Quick, test_get_collection ~fs);

     

       79
       +
           ("get all collections", `Quick, test_get_collections ~fs);

     

       80
       +
         ]

     

       81
       +
       

     

       82
       +
       let () =

     

       83
       +
         Eio_main.run @@ fun env ->

     

       84
       +
         let fs = Eio.Stdenv.fs env in

     

       85
       +
         Alcotest.run "Calendar_dir.Tests" [ ("calendar", calendar_tests fs) ]

+379

test/test_query.ml

···

       1
       +
       (* Test the Query module *)

     

       2
       +
       

     

       3
       +
       open Caledonia_lib

     

       4
       +
       

     

       5
       +
       (* Test for date expression functionality *)

     

       6
       +
       

     

       7
       +
       (* Setup a fixed date for testing *)

     

       8
       +
       let fixed_date = Option.get @@ Ptime.of_date_time ((2025, 3, 27), ((0, 0, 0), 0))

     

       9
       +
       

     

       10
       +
       let setup_fixed_date () =

     

       11
       +
         (Query.get_today := fun () -> fixed_date);

     

       12
       +
         fixed_date

     

       13
       +
       

     

       14
       +
       let test_parse_date_expression () =

     

       15
       +
         let test_expr expr parameter expected =

     

       16
       +
           try

     

       17
       +
             let result = Query.parse_date_expression expr parameter in

     

       18
       +
             let result_str =

     

       19
       +
               let y, m, d = Ptime.to_date result in

     

       20
       +
               Printf.sprintf "%04d-%02d-%02d" y m d

     

       21
       +
             in

     

       22
       +
             Alcotest.(check string)

     

       23
       +
               (Printf.sprintf "'%s' %s should parse to '%s'" expr

     

       24
       +
                  (match parameter with `From -> "from" | `To -> "to")

     

       25
       +
                  expected)

     

       26
       +
               expected result_str

     

       27
       +
           with Failure msg ->

     

       28
       +
             Alcotest.fail (Printf.sprintf "Failed to parse '%s': %s" expr msg)

     

       29
       +
         in

     

       30
       +
         test_expr "today" `From "2025-03-27";

     

       31
       +
         test_expr "today" `To "2025-03-27";

     

       32
       +
         test_expr "tomorrow" `From "2025-03-28";

     

       33
       +
         test_expr "tomorrow" `To "2025-03-28";

     

       34
       +
         test_expr "yesterday" `From "2025-03-26";

     

       35
       +
         test_expr "yesterday" `To "2025-03-26";

     

       36
       +
         test_expr "this-week" `From "2025-03-24";

     

       37
       +
         test_expr "this-week" `To "2025-03-30";

     

       38
       +
         test_expr "next-week" `From "2025-03-31";

     

       39
       +
         test_expr "next-week" `To "2025-04-06";

     

       40
       +
         test_expr "this-month" `From "2025-03-01";

     

       41
       +
         test_expr "this-month" `To "2025-03-31";

     

       42
       +
         test_expr "next-month" `From "2025-04-01";

     

       43
       +
         test_expr "next-month" `To "2025-04-30";

     

       44
       +
         test_expr "+7d" `From "2025-04-03";

     

       45
       +
         test_expr "+7d" `To "2025-04-03";

     

       46
       +
         test_expr "-7d" `From "2025-03-20";

     

       47
       +
         test_expr "-7d" `To "2025-03-20";

     

       48
       +
         test_expr "+2w" `From "2025-04-07";

     

       49
       +
         test_expr "+2w" `To "2025-04-13";

     

       50
       +
         test_expr "+1m" `From "2025-04-01";

     

       51
       +
         test_expr "+1m" `To "2025-04-30";

     

       52
       +
         test_expr "2025-01-01" `From "2025-01-01";

     

       53
       +
         test_expr "2025-01-01" `To "2025-01-01";

     

       54
       +
         (try

     

       55
       +
            let _ = Query.parse_date_expression "invalid-format" `From in

     

       56
       +
            Alcotest.fail "Should have raised an exception for invalid format"

     

       57
       +
          with Failure msg ->

     

       58
       +
            Alcotest.(check bool)

     

       59
       +
              "Invalid format should raise exception with appropriate message" true

     

       60
       +
              (String.length msg > 0));

     

       61
       +
         ()

     

       62
       +
       

     

       63
       +
       let calendar_dir_path = Filename.concat (Sys.getcwd ()) "calendar"

     

       64
       +
       

     

       65
       +
       let test_query_all ~fs () =

     

       66
       +
         let calendar_dir =

     

       67
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       68
       +
         in

     

       69
       +
         let from =

     

       70
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       71
       +
         in

     

       72
       +
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       73
       +
         match Query.query ~fs calendar_dir ~from ~to_ () with

     

       74
       +
         | Ok instances ->

     

       75
       +
             Alcotest.(check int) "Should find events" 792 (List.length instances);

     

       76
       +
             let test_event =

     

       77
       +
               List.find_opt

     

       78
       +
                 (fun instance ->

     

       79
       +
                   Event.get_summary instance.Recur.event = "Test Event")

     

       80
       +
                 instances

     

       81
       +
             in

     

       82
       +
             Alcotest.(check bool) "Should find Test Event" true (test_event <> None)

     

       83
       +
         | Error _ -> Alcotest.fail "Error querying events"

     

       84
       +
       

     

       85
       +
       let test_recurrence_expansion ~fs () =

     

       86
       +
         let calendar_dir =

     

       87
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       88
       +
         in

     

       89
       +
         let from =

     

       90
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 3, 1), ((0, 0, 0), 0)))

     

       91
       +
         in

     

       92
       +
         let to_ =

     

       93
       +
           Option.get @@ Ptime.of_date_time ((2025, 5, 31), ((23, 59, 59), 0))

     

       94
       +
         in

     

       95
       +
         match Query.query ~fs calendar_dir ~from ~to_ () with

     

       96
       +
         | Ok instances ->

     

       97
       +
             let recurring_instances =

     

       98
       +
               List.filter

     

       99
       +
                 (fun instance ->

     

       100
       +
                   Event.get_summary instance.Recur.event = "Recurring Event")

     

       101
       +
                 instances

     

       102
       +
             in

     

       103
       +
             Alcotest.(check bool)

     

       104
       +
               "Should find multiple recurring event instances" true

     

       105
       +
               (List.length recurring_instances > 1)

     

       106
       +
         | Error _ -> Alcotest.fail "Error querying events"

     

       107
       +
       

     

       108
       +
       let test_text_search ~fs () =

     

       109
       +
         let calendar_dir =

     

       110
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       111
       +
         in

     

       112
       +
         let filter = Query.summary_contains "Test" in

     

       113
       +
         let from =

     

       114
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       115
       +
         in

     

       116
       +
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       117
       +
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       118
       +
         | Ok instances ->

     

       119
       +
             Alcotest.(check int)

     

       120
       +
               "Should find event with 'Test' in summary" 2 (List.length instances)

     

       121
       +
         | Error _ -> Alcotest.fail "Error querying events");

     

       122
       +
         let filter = Query.location_contains "Weekly" in

     

       123
       +
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       124
       +
         | Ok instances ->

     

       125
       +
             Alcotest.(check int)

     

       126
       +
               "Should find event with 'Weekly' in location" 10 (List.length instances)

     

       127
       +
         | Error _ -> Alcotest.fail "Error querying events");

     

       128
       +
         let filter =

     

       129
       +
           Query.and_filter

     

       130
       +
             [ Query.summary_contains "Test"; Query.description_contains "test" ]

     

       131
       +
         in

     

       132
       +
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       133
       +
         | Ok instances ->

     

       134
       +
             Alcotest.(check int)

     

       135
       +
               "Should find events matching combined and criteria" 2

     

       136
       +
               (List.length instances)

     

       137
       +
         | Error _ -> Alcotest.fail "Error querying events");

     

       138
       +
         let filter =

     

       139
       +
           Query.or_filter

     

       140
       +
             [ Query.summary_contains "Test"; Query.location_contains "Weekly" ]

     

       141
       +
         in

     

       142
       +
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       143
       +
         | Ok instances ->

     

       144
       +
             Alcotest.(check int)

     

       145
       +
               "Should find events matching combined or criteria" 12

     

       146
       +
               (List.length instances)

     

       147
       +
         | Error _ -> Alcotest.fail "Error querying events");

     

       148
       +
         ()

     

       149
       +
       

     

       150
       +
       let test_calendar_filter ~fs () =

     

       151
       +
         let calendar_dir =

     

       152
       +
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       153
       +
         in

     

       154
       +
         let from =

     

       155
       +
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       156
       +
         in

     

       157
       +
         let to_ = Option.get @@ Ptime.of_date_time ((2026, 01, 01), ((0, 0, 0), 0)) in

     

       158
       +
         let collection = Calendar_dir.Collection "example" in

     

       159
       +
         let filter = Query.in_collections [ collection ] in

     

       160
       +
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       161
       +
         | Ok instances ->

     

       162
       +
             let all_match_calendar =

     

       163
       +
               List.for_all

     

       164
       +
                 (fun e ->

     

       165
       +
                   match Event.get_collection e.Recur.event with

     

       166
       +
                   | Some id -> id = collection

     

       167
       +
                   | None -> false)

     

       168
       +
                 instances

     

       169
       +
             in

     

       170
       +
             Alcotest.(check bool)

     

       171
       +
               (Printf.sprintf "All events should be from calendar '%s'"

     

       172
       +
                  (match collection with Collection str -> str))

     

       173
       +
               true all_match_calendar;

     

       174
       +
             Alcotest.(check int) "Should find events" 2 (List.length instances)

     

       175
       +
         | Error _ -> Alcotest.fail "Error querying events");

     

       176
       +
         let collections =

     

       177
       +
           [ Calendar_dir.Collection "example"; Calendar_dir.Collection "recurrence" ]

     

       178
       +
         in

     

       179
       +
         let filter = Query.in_collections collections in

     

       180
       +
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       181
       +
         | Ok instances ->

     

       182
       +
             Alcotest.(check int) "Should find events" 792 (List.length instances)

     

       183
       +
         | Error _ -> Alcotest.fail "Error querying events");

     

       184
       +
         let filter =

     

       185
       +
           Query.in_collections [ Calendar_dir.Collection "non-existent-calendar" ]

     

       186
       +
         in

     

       187
       +
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       188
       +
         | Ok instances ->

     

       189
       +
             Alcotest.(check int)

     

       190
       +
               "Should find 0 events for non-existent calendar" 0

     

       191
       +
               (List.length instances)

     

       192
       +
         | Error _ -> Alcotest.fail "Error querying events");

     

       193
       +
         ()

     

       194
       +
       

     

       195
       +
       let test_events =

     

       196
       +
         (* Create a test event with specific text in all fields *)

     

       197
       +
         let create_test_event ~collection ~summary ~description ~location ~start =

     

       198
       +
           Event.create ~collection:(Calendar_dir.Collection collection) ~summary

     

       199
       +
             ~start

     

       200
       +
             ?description:(if description = "" then None else Some description)

     

       201
       +
             ?location:(if location = "" then None else Some location)

     

       202
       +
             ()

     

       203
       +
         in

     

       204
       +
         [

     

       205
       +
           (* Event with text in all fields *)

     

       206
       +
           create_test_event ~collection:"search_test" ~summary:"Project Meeting"

     

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

     

       208
       +
             ~location:"Conference Room A" ~start:fixed_date;

     

       209
       +
           (* Event with mixed case to test case insensitivity *)

     

       210
       +
           create_test_event ~collection:"search_test" ~summary:"IMPORTANT Meeting"

     

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

     

       212
       +
             ~location:"Executive Suite" ~start:fixed_date;

     

       213
       +
           (* Event with word fragments *)

     

       214
       +
           create_test_event ~collection:"search_test" ~summary:"Conference Call"

     

       215
       +
             ~description:"International conference preparation"

     

       216
       +
             ~location:"Remote Meeting Room" ~start:fixed_date;

     

       217
       +
           (* Event with unique text in each field *)

     

       218
       +
           create_test_event ~collection:"search_test" ~summary:"Workshop on Testing"

     

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

     

       220
       +
             ~location:"Training Center" ~start:fixed_date;

     

       221
       +
         ]

     

       222
       +
       

     

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

     

       224
       +
       let contains_summary events summary =

     

       225
       +
         List.exists (fun e -> String.equal (Event.get_summary e) summary) events

     

       226
       +
       

     

       227
       +
       let test_case_insensitive_search () =

     

       228
       +
         (* Test lowercase query for an uppercase word *)

     

       229
       +
         let lowercase_filter = Query.summary_contains "important" in

     

       230
       +
         let matches =

     

       231
       +
           List.filter (fun e -> Query.matches_filter e lowercase_filter) test_events

     

       232
       +
         in

     

       233
       +
         Alcotest.(check bool)

     

       234
       +
           "Lowercase query should match uppercase text in summary" true

     

       235
       +
           (contains_summary matches "IMPORTANT Meeting");

     

       236
       +
         (* Test uppercase query for a lowercase word *)

     

       237
       +
         let uppercase_filter = Query.description_contains "WEEKLY" in

     

       238
       +
         let matches =

     

       239
       +
           List.filter (fun e -> Query.matches_filter e uppercase_filter) test_events

     

       240
       +
         in

     

       241
       +
         Alcotest.(check bool)

     

       242
       +
           "Uppercase query should match lowercase text in description" true

     

       243
       +
           (contains_summary matches "Project Meeting")

     

       244
       +
       

     

       245
       +
       let test_partial_word_matching () =

     

       246
       +
         (* Test searching for part of a word *)

     

       247
       +
         let partial_filter = Query.summary_contains "Conf" in

     

       248
       +
         (* Should match "Conference" *)

     

       249
       +
         let matches =

     

       250
       +
           List.filter (fun e -> Query.matches_filter e partial_filter) test_events

     

       251
       +
         in

     

       252
       +
         Alcotest.(check bool)

     

       253
       +
           "Partial query should match full word in summary" true

     

       254
       +
           (contains_summary matches "Conference Call");

     

       255
       +
         (* Test another partial word in description *)

     

       256
       +
         let partial_filter = Query.description_contains "nation" in

     

       257
       +
         (* Should match "International" *)

     

       258
       +
         let matches =

     

       259
       +
           List.filter (fun e -> Query.matches_filter e partial_filter) test_events

     

       260
       +
         in

     

       261
       +
         Alcotest.(check bool)

     

       262
       +
           "Partial query should match within word in description" true

     

       263
       +
           (contains_summary matches "Conference Call");

     

       264
       +
       

     

       265
       +
          Alcotest.(check bool)

     

       266
       +
            "Partial query should match within word in description" true

     

       267
       +
           (contains_summary matches "Conference Call")

     

       268
       +
       

     

       269
       +
       let test_boolean_logic () =

     

       270
       +
         (* Test AND filter *)

     

       271
       +
         let and_filter =

     

       272
       +
           Query.and_filter

     

       273
       +
             [ Query.summary_contains "Meeting"; Query.description_contains "project" ]

     

       274
       +
         in

     

       275
       +
         let matches =

     

       276
       +
           List.filter (fun e -> Query.matches_filter e and_filter) test_events

     

       277
       +
         in

     

       278
       +
         Alcotest.(check int)

     

       279
       +
           "AND filter should match events with both terms" 2

     

       280
       +
           (* Two events have both "Meeting" in summary and "project" in description *)

     

       281
       +
           (List.length matches);

     

       282
       +
         (* Test OR filter *)

     

       283
       +
         let or_filter =

     

       284
       +
           Query.or_filter

     

       285
       +
             [ Query.summary_contains "Workshop"; Query.summary_contains "Conference" ]

     

       286
       +
         in

     

       287
       +
         let matches =

     

       288
       +
           List.filter (fun e -> Query.matches_filter e or_filter) test_events

     

       289
       +
         in

     

       290
       +
         Alcotest.(check int)

     

       291
       +
           "OR filter should match events with either term"

     

       292
       +
           2 (* One event has "Workshop", one has "Conference" *)

     

       293
       +
           (List.length matches);

     

       294
       +
       

     

       295
       +
         (* Test NOT filter *)

     

       296
       +
         let not_filter = Query.not_filter (Query.summary_contains "Meeting") in

     

       297
       +
          let matches =

     

       298
       +
            List.filter (fun e -> Query.matches_filter e not_filter) test_events

     

       299
       +
          in

     

       300
       +
         Alcotest.(check int)

     

       301
       +
           "NOT filter should match events without the term"

     

       302
       +
           2 (* Two events don't have "Meeting" in the summary *)

     

       303
       +
           (List.length matches);

     

       304
       +
         (* Test complex combination: (Meeting AND project) OR Workshop BUT NOT Conference *)

     

       305
       +
         let complex_filter =

     

       306
       +
           Query.and_filter

     

       307
       +
             [

     

       308
       +
               Query.or_filter

     

       309
       +
                 [

     

       310
       +
                   Query.and_filter

     

       311
       +
                     [

     

       312
       +
                       Query.summary_contains "Meeting";

     

       313
       +
                       Query.description_contains "project";

     

       314
       +
                     ];

     

       315
       +
                   Query.summary_contains "Workshop";

     

       316
       +
                 ];

     

       317
       +
               Query.not_filter (Query.summary_contains "Conference");

     

       318
       +
             ]

     

       319
       +
         in

     

       320
       +
         let matches =

     

       321
       +
           List.filter (fun e -> Query.matches_filter e complex_filter) test_events

     

       322
       +
         in

     

       323
       +
         Alcotest.(check int)

     

       324
       +
           "Complex filter should match correctly"

     

       325
       +
           3 (* Three events should match the complex criteria *)

     

       326
       +
           (List.length matches)

     

       327
       +
       

     

       328
       +
       let test_cross_field_search () =

     

       329
       +
         (* Search for a term that appears in multiple fields across different events *)

     

       330
       +
         let term_filter =

     

       331
       +
           Query.or_filter

     

       332
       +
             [

     

       333
       +
               Query.summary_contains "meeting";

     

       334
       +
               Query.description_contains "meeting";

     

       335
       +
               Query.location_contains "meeting";

     

       336
       +
             ]

     

       337
       +
         in

     

       338
       +
         let matches =

     

       339
       +
           List.filter (fun e -> Query.matches_filter e term_filter) test_events

     

       340
       +
         in

     

       341
       +
         Alcotest.(check int)

     

       342
       +
           "Cross-field search should find all occurrences"

     

       343
       +
           3 (* "meeting" appears in 3 events across different fields *)

     

       344
       +
           (List.length matches);

     

       345
       +
         (* Another test with a different term *)

     

       346
       +
         let term_filter =

     

       347
       +
           Query.or_filter

     

       348
       +
             [

     

       349
       +
               Query.summary_contains "conference";

     

       350
       +
               Query.description_contains "conference";

     

       351
       +
               Query.location_contains "conference";

     

       352
       +
             ]

     

       353
       +
         in

     

       354
       +
         let matches =

     

       355
       +
           List.filter (fun e -> Query.matches_filter e term_filter) test_events

     

       356
       +
         in

     

       357
       +
         Alcotest.(check int)

     

       358
       +
           "Cross-field search should find all occurrences of 'conference'"

     

       359
       +
           2 (* "conference" appears in 2 events across different fields *)

     

       360
       +
           (List.length matches)

     

       361
       +
       

     

       362
       +
       let query_tests fs =

     

       363
       +
         [

     

       364
       +
           ("date expression parsing", `Quick, test_parse_date_expression);

     

       365
       +
           ("query all events", `Quick, test_query_all ~fs);

     

       366
       +
           ("recurrence expansion", `Quick, test_recurrence_expansion ~fs);

     

       367
       +
           ("text search", `Quick, test_text_search ~fs);

     

       368
       +
           ("calendar filter", `Quick, test_calendar_filter ~fs);

     

       369
       +
           ("case insensitive search", `Quick, test_case_insensitive_search);

     

       370
       +
           ("partial word matching", `Quick, test_partial_word_matching);

     

       371
       +
           ("boolean logic filters", `Quick, test_boolean_logic);

     

       372
       +
           ("cross-field searching", `Quick, test_cross_field_search);

     

       373
       +
         ]

     

       374
       +
       

     

       375
       +
       let () =

     

       376
       +
         Eio_main.run @@ fun env ->

     

       377
       +
         let fs = Eio.Stdenv.fs env in

     

       378
       +
         let _ = setup_fixed_date () in

     

       379
       +
         Alcotest.run "Query Tests" [ ("query", query_tests fs) ]

+744

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:(Calendar_dir.Collection "test") ()

     

       16
       +
         in

     

       17
       +
         let test_date_range from_str to_str expected_count =

     

       18
       +
           try

     

       19
       +
             let from = Some (Query.parse_date_expression from_str `From) in

     

       20
       +
             let to_ = Query.parse_date_expression 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_path = 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
       +
                 match

     

       88
       +
                   Event.of_icalendar (Calendar_dir.Collection "example") ical_event

     

       89
       +
                 with

     

       90
       +
                 | Ok event -> event

     

       91
       +
                 | Error (`Msg msg) ->

     

       92
       +
                     failwith

     

       93
       +
                       (Printf.sprintf "Error parsing event from %s: %s\n%!" file_path

     

       94
       +
                          msg)))

     

       95
       +
       

     

       96
       +
       (* Format RRULE for display *)

     

       97
       +
       let format_rrule_str rule =

     

       98
       +
         let freq, until_count, interval, _ = rule in

     

       99
       +
         let freq_str =

     

       100
       +
           match freq with

     

       101
       +
           | `Daily -> "DAILY"

     

       102
       +
           | `Weekly -> "WEEKLY"

     

       103
       +
           | `Monthly -> "MONTHLY"

     

       104
       +
           | `Yearly -> "YEARLY"

     

       105
       +
           | _ -> "OTHER"

     

       106
       +
         in

     

       107
       +
         let count_until_str =

     

       108
       +
           match until_count with

     

       109
       +
           | Some (`Count n) -> Printf.sprintf "COUNT=%d" n

     

       110
       +
           | Some (`Until _) -> "UNTIL=..."

     

       111
       +
           | None -> ""

     

       112
       +
         in

     

       113
       +
         let interval_str =

     

       114
       +
           match interval with Some n -> Printf.sprintf "INTERVAL=%d" n | None -> ""

     

       115
       +
         in

     

       116
       +
         let parts =

     

       117
       +
           List.filter (fun s -> s <> "") [ freq_str; count_until_str; interval_str ]

     

       118
       +
         in

     

       119
       +
         "RRULE:" ^ String.concat ";" parts

     

       120
       +
       

     

       121
       +
       (* Common recurrence test logic *)

     

       122
       +
       let test_recurrence_expansion ~fs event_file start_str end_str expected_count =

     

       123
       +
         let event = load_event_from_file ~fs event_file in

     

       124
       +
         let start_date = parse_date start_str in

     

       125
       +
         let end_date = parse_date end_str in

     

       126
       +
         let instances =

     

       127
       +
           Recur.expand_event event ~from:(Some start_date) ~to_:end_date

     

       128
       +
         in

     

       129
       +
         (* Format readable info for test failure messages *)

     

       130
       +
         let rrule_str =

     

       131
       +
           match Event.get_recurrence event with

     

       132
       +
           | Some rule -> format_rrule_str rule

     

       133
       +
           | None -> "No recurrence rule"

     

       134
       +
         in

     

       135
       +
         let summary = Event.get_summary event in

     

       136
       +
         let msg =

     

       137
       +
           Printf.sprintf

     

       138
       +
             "Expected %d instances for '%s' (%s) between %s and %s, but got %d"

     

       139
       +
             expected_count summary rrule_str start_str end_str (List.length instances)

     

       140
       +
         in

     

       141
       +
         Alcotest.(check int) msg expected_count (List.length instances);

     

       142
       +
         instances

     

       143
       +
       

     

       144
       +
       (* Helper to verify instances are properly spaced *)

     

       145
       +
       let verify_instance_spacing instances expected_interval =

     

       146
       +
         if List.length instances < 2 then

     

       147
       +
           Alcotest.(check bool) "Should have at least 2 unique instances" true false

     

       148
       +
         else

     

       149
       +
           let errors = ref [] in

     

       150
       +
           ignore

     

       151
       +
             (List.fold_left

     

       152
       +
                (fun prev curr ->

     

       153
       +
                  let span = Ptime.diff curr.Recur.start prev.Recur.start in

     

       154
       +
                  let days_diff =

     

       155
       +
                    Ptime.Span.to_float_s span /. float_of_int day_seconds

     

       156
       +
                    |> Float.round |> int_of_float

     

       157
       +
                  in

     

       158
       +
                  if days_diff <> expected_interval then

     

       159
       +
                    errors := (prev, curr, days_diff) :: !errors;

     

       160
       +
                  curr)

     

       161
       +
                (List.hd instances) (List.tl instances));

     

       162
       +
           match !errors with

     

       163
       +
           | [] -> ()

     

       164
       +
           | (prev, curr, actual) :: _ ->

     

       165
       +
               let msg =

     

       166
       +
                 Printf.sprintf

     

       167
       +
                   "Expected interval of %d days, but found %d days between %s and %s"

     

       168
       +
                   expected_interval actual

     

       169
       +
                   (Ptime.to_rfc3339 ~space:true prev.Recur.start)

     

       170
       +
                   (Ptime.to_rfc3339 ~space:true curr.Recur.start)

     

       171
       +
               in

     

       172
       +
               if actual = 0 then

     

       173
       +
                 (* Ignore zero interval errors for now - this means we have duplicates *)

     

       174
       +
                 ()

     

       175
       +
               else Alcotest.(check int) msg expected_interval actual

     

       176
       +
       

     

       177
       +
       let test_daily ~fs () =

     

       178
       +
         let instances =

     

       179
       +
           test_recurrence_expansion ~fs "1_daily.ics" "2025-03-27" "2025-04-10" 14

     

       180
       +
         in

     

       181
       +
         verify_instance_spacing instances 1

     

       182
       +
       

     

       183
       +
       let test_weekly ~fs () =

     

       184
       +
         let instances =

     

       185
       +
           test_recurrence_expansion ~fs "2_weekly.ics" "2025-03-27" "2025-06-27" 14

     

       186
       +
         in

     

       187
       +
         verify_instance_spacing instances 7

     

       188
       +
       

     

       189
       +
       let test_monthly ~fs () =

     

       190
       +
         let instances =

     

       191
       +
           test_recurrence_expansion ~fs "3_monthly.ics" "2025-01-01" "2025-12-31" 8

     

       192
       +
         in

     

       193
       +
         (* Just verify the results without checking the interval, since months have different lengths *)

     

       194
       +
         let first_instance = List.hd instances in

     

       195
       +
         let (_, _, first_day), _ = Ptime.to_date_time first_instance.Recur.start in

     

       196
       +
         (* Check that they all fall on the same day of the month *)

     

       197
       +
         let all_same_day =

     

       198
       +
           List.for_all

     

       199
       +
             (fun instance ->

     

       200
       +
               let (_, _, day), _ = Ptime.to_date_time instance.Recur.start in

     

       201
       +
               day = first_day)

     

       202
       +
             instances

     

       203
       +
         in

     

       204
       +
         Alcotest.(check bool)

     

       205
       +
           (Printf.sprintf "All instances should be on day %d of the month" first_day)

     

       206
       +
           true all_same_day

     

       207
       +
       

     

       208
       +
       let test_yearly ~fs () =

     

       209
       +
         let instances =

     

       210
       +
           test_recurrence_expansion ~fs "4_yearly.ics" "2025-01-01" "2035-12-31" 11

     

       211
       +
         in

     

       212
       +
         (* Verify instances are one year apart by checking the date *)

     

       213
       +
         let all_same_month_day =

     

       214
       +
           if List.length instances < 2 then true

     

       215
       +
           else

     

       216
       +
             let first = List.hd instances in

     

       217
       +
             let (_, first_month, first_day), _ =

     

       218
       +
               Ptime.to_date_time first.Recur.start

     

       219
       +
             in

     

       220
       +
             List.for_all

     

       221
       +
               (fun instance ->

     

       222
       +
                 let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       223
       +
                 month = first_month && day = first_day)

     

       224
       +
               instances

     

       225
       +
         in

     

       226
       +
         Alcotest.(check bool)

     

       227
       +
           "All instances should be on the same day/month" true all_same_month_day

     

       228
       +
       

     

       229
       +
       let test_every_2_days ~fs () =

     

       230
       +
         let instances =

     

       231
       +
           test_recurrence_expansion ~fs "5_every_2_days.ics" "2025-05-01" "2025-05-31"

     

       232
       +
             15

     

       233
       +
         in

     

       234
       +
         verify_instance_spacing instances 2

     

       235
       +
       

     

       236
       +
       let test_every_3_weeks ~fs () =

     

       237
       +
         let instances =

     

       238
       +
           test_recurrence_expansion ~fs "6_every_3_weeks.ics" "2025-05-01"

     

       239
       +
             "2025-08-31" 6

     

       240
       +
         in

     

       241
       +
         verify_instance_spacing instances 21 (* 3 weeks = 21 days *)

     

       242
       +
       

     

       243
       +
       let test_bimonthly ~fs () =

     

       244
       +
         let instances =

     

       245
       +
           test_recurrence_expansion ~fs "7_bimonthly.ics" "2025-05-01" "2026-05-31" 7

     

       246
       +
         in

     

       247
       +
         (* Verify all instances are on the same day of month *)

     

       248
       +
         let first_instance = List.hd instances in

     

       249
       +
         let (_, _, first_day), _ = Ptime.to_date_time first_instance.Recur.start in

     

       250
       +
         let all_same_day =

     

       251
       +
           List.for_all

     

       252
       +
             (fun instance ->

     

       253
       +
               let (_, _, day), _ = Ptime.to_date_time instance.Recur.start in

     

       254
       +
               day = first_day)

     

       255
       +
             instances

     

       256
       +
         in

     

       257
       +
         Alcotest.(check bool)

     

       258
       +
           (Printf.sprintf "All instances should be on day %d of the month" first_day)

     

       259
       +
           true all_same_day

     

       260
       +
       

     

       261
       +
       let test_biennial ~fs () =

     

       262
       +
         let instances =

     

       263
       +
           test_recurrence_expansion ~fs "8_biennial.ics" "2025-01-01" "2035-12-31" 6

     

       264
       +
         in

     

       265
       +
         (* Verify all instances are on the same month and day, every two years *)

     

       266
       +
         let first_instance = List.hd instances in

     

       267
       +
         let (first_year, first_month, first_day), _ =

     

       268
       +
           Ptime.to_date_time first_instance.Recur.start

     

       269
       +
         in

     

       270
       +
         let all_same_date_alternate_years =

     

       271
       +
           List.for_all

     

       272
       +
             (fun instance ->

     

       273
       +
               let (year, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       274
       +
               month = first_month && day = first_day && (year - first_year) mod 2 = 0)

     

       275
       +
             instances

     

       276
       +
         in

     

       277
       +
         Alcotest.(check bool)

     

       278
       +
           "All instances should be on same day/month every two years" true

     

       279
       +
           all_same_date_alternate_years

     

       280
       +
       

     

       281
       +
       let test_daily_count5 ~fs () =

     

       282
       +
         let instances =

     

       283
       +
           test_recurrence_expansion ~fs "9_daily_count5.ics" "2025-05-01" "2025-05-31"

     

       284
       +
             5

     

       285
       +
         in

     

       286
       +
         Alcotest.(check int)

     

       287
       +
           "Should have exactly 5 instances" 5 (List.length instances);

     

       288
       +
         verify_instance_spacing instances 1

     

       289
       +
       

     

       290
       +
       let test_weekly_count10 ~fs () =

     

       291
       +
         let instances =

     

       292
       +
           test_recurrence_expansion ~fs "10_weekly_count10.ics" "2025-03-17"

     

       293
       +
             "2025-06-30" 10

     

       294
       +
         in

     

       295
       +
         verify_instance_spacing instances 7

     

       296
       +
       

     

       297
       +
       let test_daily_until ~fs () =

     

       298
       +
         let instances =

     

       299
       +
           test_recurrence_expansion ~fs "11_daily_until.ics" "2025-05-01" "2025-05-31"

     

       300
       +
             14

     

       301
       +
         in

     

       302
       +
         (* Verify instances only occur until May 15 *)

     

       303
       +
         let last_instance =

     

       304
       +
           List.fold_left

     

       305
       +
             (fun latest curr ->

     

       306
       +
               if Ptime.compare curr.Recur.start latest.Recur.start > 0 then curr

     

       307
       +
               else latest)

     

       308
       +
             (List.hd instances) instances

     

       309
       +
         in

     

       310
       +
         let (_, month, day), _ = Ptime.to_date_time last_instance.Recur.start in

     

       311
       +
         Alcotest.(check int) "Last instance should be in May" 5 month;

     

       312
       +
         Alcotest.(check bool)

     

       313
       +
           "Last instance should be on or before May 15" true (day <= 15);

     

       314
       +
         verify_instance_spacing instances 1

     

       315
       +
       

     

       316
       +
       let test_weekly_until ~fs () =

     

       317
       +
         let instances =

     

       318
       +
           test_recurrence_expansion ~fs "12_weekly_until.ics" "2025-05-01"

     

       319
       +
             "2025-07-31" 9

     

       320
       +
         in

     

       321
       +
         (* Verify instances only occur until June 30 *)

     

       322
       +
         let last_instance =

     

       323
       +
           List.fold_left

     

       324
       +
             (fun latest curr ->

     

       325
       +
               if Ptime.compare curr.Recur.start latest.Recur.start > 0 then curr

     

       326
       +
               else latest)

     

       327
       +
             (List.hd instances) instances

     

       328
       +
         in

     

       329
       +
         let (_, month, day), _ = Ptime.to_date_time last_instance.Recur.start in

     

       330
       +
         Alcotest.(check int) "Last instance should be in June" 6 month;

     

       331
       +
         Alcotest.(check bool)

     

       332
       +
           "Last instance should be on or before June 30" true (day <= 30);

     

       333
       +
         verify_instance_spacing instances 7

     

       334
       +
       

     

       335
       +
       let test_weekly_monday_wednesday ~fs () =

     

       336
       +
         let instances =

     

       337
       +
           test_recurrence_expansion ~fs "13_weekly_monday_wednesday.ics" "2025-03-24"

     

       338
       +
             "2025-04-30" 11

     

       339
       +
         in

     

       340
       +
         let check_day_of_week instance day_list =

     

       341
       +
           let date = instance.Recur.start in

     

       342
       +
           let weekday =

     

       343
       +
             match Ptime.weekday ~tz_offset_s:0 date with

     

       344
       +
             | `Mon -> 1

     

       345
       +
             | `Tue -> 2

     

       346
       +
             | `Wed -> 3

     

       347
       +
             | `Thu -> 4

     

       348
       +
             | `Fri -> 5

     

       349
       +
             | `Sat -> 6

     

       350
       +
             | `Sun -> 0

     

       351
       +
           in

     

       352
       +
           List.mem weekday day_list

     

       353
       +
         in

     

       354
       +
         let all_on_mon_wed =

     

       355
       +
           List.for_all

     

       356
       +
             (fun instance ->

     

       357
       +
               check_day_of_week instance [ 1; 3 ] (* Monday = 1, Wednesday = 3 *))

     

       358
       +
             instances

     

       359
       +
         in

     

       360
       +
         Alcotest.(check bool)

     

       361
       +
           "All instances should be on Monday or Wednesday" true all_on_mon_wed

     

       362
       +
       

     

       363
       +
       let test_weekly_weekends ~fs () =

     

       364
       +
         let instances =

     

       365
       +
           test_recurrence_expansion ~fs "14_weekly_weekends.ics" "2025-05-01"

     

       366
       +
             "2025-06-30" 18

     

       367
       +
         in

     

       368
       +
         let check_day_of_week instance day_list =

     

       369
       +
           let date = instance.Recur.start in

     

       370
       +
           let weekday =

     

       371
       +
             match Ptime.weekday ~tz_offset_s:0 date with

     

       372
       +
             | `Mon -> 1

     

       373
       +
             | `Tue -> 2

     

       374
       +
             | `Wed -> 3

     

       375
       +
             | `Thu -> 4

     

       376
       +
             | `Fri -> 5

     

       377
       +
             | `Sat -> 6

     

       378
       +
             | `Sun -> 0

     

       379
       +
           in

     

       380
       +
           List.mem weekday day_list

     

       381
       +
         in

     

       382
       +
         let all_on_weekends =

     

       383
       +
           List.for_all

     

       384
       +
             (fun instance ->

     

       385
       +
               check_day_of_week instance [ 6; 0 ] (* Saturday = 6, Sunday = 0 *))

     

       386
       +
             instances

     

       387
       +
         in

     

       388
       +
         Alcotest.(check bool)

     

       389
       +
           "All instances should be on Saturday or Sunday" true all_on_weekends

     

       390
       +
       

     

       391
       +
       let test_monthly_specific_day ~fs () =

     

       392
       +
         let instances =

     

       393
       +
           test_recurrence_expansion ~fs "15_monthly_specific_day.ics" "2025-01-01"

     

       394
       +
             "2025-12-31" 8

     

       395
       +
         in

     

       396
       +
         (* Verify all instances are on the same day of month *)

     

       397
       +
         let first_instance = List.hd instances in

     

       398
       +
         let (_, _, first_day), _ = Ptime.to_date_time first_instance.Recur.start in

     

       399
       +
         let all_same_day =

     

       400
       +
           List.for_all

     

       401
       +
             (fun instance ->

     

       402
       +
               let (_, _, day), _ = Ptime.to_date_time instance.Recur.start in

     

       403
       +
               day = first_day)

     

       404
       +
             instances

     

       405
       +
         in

     

       406
       +
         Alcotest.(check bool)

     

       407
       +
           (Printf.sprintf "All instances should be on day %d of the month" first_day)

     

       408
       +
           true all_same_day

     

       409
       +
       

     

       410
       +
       let test_monthly_second_monday ~fs () =

     

       411
       +
         let instances =

     

       412
       +
           test_recurrence_expansion ~fs "16_monthly_second_monday.ics" "2025-05-01"

     

       413
       +
             "2026-04-30" 11

     

       414
       +
         in

     

       415
       +
         let check_day_of_week instance =

     

       416
       +
           let date = instance.Recur.start in

     

       417
       +
           let weekday =

     

       418
       +
             match Ptime.weekday ~tz_offset_s:0 date with `Mon -> true | _ -> false

     

       419
       +
           in

     

       420
       +
           let (_, _, day), _ = Ptime.to_date_time date in

     

       421
       +
           weekday && day >= 8 && day <= 14 (* Second Monday is between 8th and 14th *)

     

       422
       +
         in

     

       423
       +
         let all_second_mondays = List.for_all check_day_of_week instances in

     

       424
       +
         Alcotest.(check bool)

     

       425
       +
           "All instances should be on the second Monday of each month" true

     

       426
       +
           all_second_mondays

     

       427
       +
       

     

       428
       +
       let test_monthly_last_day ~fs () =

     

       429
       +
         let instances =

     

       430
       +
           test_recurrence_expansion ~fs "17_monthly_last_day.ics" "2025-05-01"

     

       431
       +
             "2026-04-30" 11

     

       432
       +
         in

     

       433
       +
         let is_last_day_of_month instance =

     

       434
       +
           let date = instance.Recur.start in

     

       435
       +
           let (year, month, day), _ = Ptime.to_date_time date in

     

       436
       +
           let last_day =

     

       437
       +
             match month with

     

       438
       +
             | 2 ->

     

       439
       +
                 if (year mod 4 = 0 && year mod 100 <> 0) || year mod 400 = 0 then 29

     

       440
       +
                 else 28

     

       441
       +
             | 4 | 6 | 9 | 11 -> 30

     

       442
       +
             | _ -> 31

     

       443
       +
           in

     

       444
       +
           day = last_day

     

       445
       +
         in

     

       446
       +
         let all_last_days = List.for_all is_last_day_of_month instances in

     

       447
       +
         Alcotest.(check bool)

     

       448
       +
           "All instances should be on the last day of each month" true all_last_days

     

       449
       +
       

     

       450
       +
       let test_yearly_specific_date ~fs () =

     

       451
       +
         let instances =

     

       452
       +
           test_recurrence_expansion ~fs "18_yearly_specific_date.ics" "2025-01-01"

     

       453
       +
             "2035-12-31" 11

     

       454
       +
         in

     

       455
       +
         (* Verify all instances are on the same month and day *)

     

       456
       +
         let first_instance = List.hd instances in

     

       457
       +
         let (_, first_month, first_day), _ =

     

       458
       +
           Ptime.to_date_time first_instance.Recur.start

     

       459
       +
         in

     

       460
       +
         let all_same_date =

     

       461
       +
           List.for_all

     

       462
       +
             (fun instance ->

     

       463
       +
               let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       464
       +
               month = first_month && day = first_day)

     

       465
       +
             instances

     

       466
       +
         in

     

       467
       +
         Alcotest.(check bool)

     

       468
       +
           (Printf.sprintf "All instances should be on %d/%d" first_month first_day)

     

       469
       +
           true all_same_date

     

       470
       +
       

     

       471
       +
       let test_yearly_mothers_day ~fs () =

     

       472
       +
         let instances =

     

       473
       +
           test_recurrence_expansion ~fs "19_yearly_mothers_day.ics" "2025-01-01"

     

       474
       +
             "2035-12-31" 10

     

       475
       +
         in

     

       476
       +
         let is_second_sunday_in_may instance =

     

       477
       +
           let date = instance.Recur.start in

     

       478
       +
           let (_, month, day), _ = Ptime.to_date_time date in

     

       479
       +
           let is_sunday =

     

       480
       +
             match Ptime.weekday ~tz_offset_s:0 date with `Sun -> true | _ -> false

     

       481
       +
           in

     

       482
       +
           month = 5 && is_sunday && day >= 8

     

       483
       +
           && day <= 14 (* Second Sunday is between 8th and 14th *)

     

       484
       +
         in

     

       485
       +
         let all_mothers_days = List.for_all is_second_sunday_in_may instances in

     

       486
       +
         Alcotest.(check bool)

     

       487
       +
           "All instances should be on the second Sunday in May" true all_mothers_days

     

       488
       +
       

     

       489
       +
       let test_complex_weekdays_months ~fs () =

     

       490
       +
         let instances =

     

       491
       +
           test_recurrence_expansion ~fs "20_complex_weekdays_months.ics" "2025-05-01"

     

       492
       +
             "2025-09-30" 26

     

       493
       +
         in

     

       494
       +
         let is_tue_thu_in_summer instance =

     

       495
       +
           let date = instance.Recur.start in

     

       496
       +
           let (_, month, _), _ = Ptime.to_date_time date in

     

       497
       +
           let is_tue_thu =

     

       498
       +
             match Ptime.weekday ~tz_offset_s:0 date with

     

       499
       +
             | `Tue | `Thu -> true

     

       500
       +
             | _ -> false

     

       501
       +
           in

     

       502
       +
           is_tue_thu && (month = 6 || month = 7 || month = 8)

     

       503
       +
           (* Jun, Jul, Aug *)

     

       504
       +
         in

     

       505
       +
         let all_valid = List.for_all is_tue_thu_in_summer instances in

     

       506
       +
         Alcotest.(check bool)

     

       507
       +
           "All instances should be on Tuesday/Thursday in summer months" true

     

       508
       +
           all_valid

     

       509
       +
       

     

       510
       +
       let test_complex_multiple_monthdays ~fs () =

     

       511
       +
         let instances =

     

       512
       +
           test_recurrence_expansion ~fs "21_complex_multiple_monthdays.ics"

     

       513
       +
             "2025-05-01" "2026-05-31" 38

     

       514
       +
         in

     

       515
       +
         (* Verify instances fall on the specified days (1st, 15th, or last day of month) *)

     

       516
       +
         let valid_day =

     

       517
       +
          fun day month ->

     

       518
       +
           day = 1 || day = 15

     

       519
       +
           || (month = 1 && day = 31)

     

       520
       +
           (* not a leap year *)

     

       521
       +
           || (month = 2 && day = 28)

     

       522
       +
           || (month = 3 && day = 31)

     

       523
       +
           || (month = 4 && day = 30)

     

       524
       +
           || (month = 5 && day = 31)

     

       525
       +
           || (month = 6 && day = 30)

     

       526
       +
           || (month = 7 && day = 31)

     

       527
       +
           || (month = 8 && day = 31)

     

       528
       +
           || (month = 9 && day = 30)

     

       529
       +
           || (month = 10 && day = 31)

     

       530
       +
           || (month = 11 && day = 30)

     

       531
       +
           || (month = 12 && day = 31)

     

       532
       +
         in

     

       533
       +
         let all_valid_days =

     

       534
       +
           List.for_all

     

       535
       +
             (fun instance ->

     

       536
       +
               let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       537
       +
               valid_day day month)

     

       538
       +
             instances

     

       539
       +
         in

     

       540
       +
         Alcotest.(check bool)

     

       541
       +
           "All instances should be on 1st, 15th, or last day of month" true

     

       542
       +
           all_valid_days

     

       543
       +
       

     

       544
       +
       let test_with_exdate ~fs () =

     

       545
       +
         let instances =

     

       546
       +
           test_recurrence_expansion ~fs "22_with_exdate.ics" "2025-05-01" "2025-06-30"

     

       547
       +
             9

     

       548
       +
         in

     

       549
       +
         (* Verify that excluded dates (May 15 and May 29) are not in the instances *)

     

       550
       +
         let excluded_dates = [ parse_date "2025-05-15"; parse_date "2025-05-29" ] in

     

       551
       +
         let no_excluded_dates =

     

       552
       +
           List.for_all

     

       553
       +
             (fun instance ->

     

       554
       +
               let check_not_excluded excluded =

     

       555
       +
                 Ptime.compare instance.Recur.start excluded <> 0

     

       556
       +
               in

     

       557
       +
               List.for_all check_not_excluded excluded_dates)

     

       558
       +
             instances

     

       559
       +
         in

     

       560
       +
         Alcotest.(check bool)

     

       561
       +
           "No instances should be on excluded dates" true no_excluded_dates;

     

       562
       +
         (* Weekly recurrence should have 9 instances in this period *)

     

       563
       +
         Alcotest.(check int) "Should have 9 instances" 9 (List.length instances)

     

       564
       +
       

     

       565
       +
       let test_dst_transition ~fs () =

     

       566
       +
         (* This event occurs from 2025-10-27 to 2025-11-17 *)

     

       567
       +
         let instances =

     

       568
       +
           test_recurrence_expansion ~fs "23_dst_transition.ics" "2025-10-01"

     

       569
       +
             "2025-11-30" 4

     

       570
       +
         in

     

       571
       +
         Alcotest.(check int)

     

       572
       +
           "Should have 4 instances across DST transition" 4 (List.length instances);

     

       573
       +
         (* Check each consecutive pair of dates *)

     

       574
       +
         ignore

     

       575
       +
           (List.fold_left

     

       576
       +
              (fun prev curr ->

     

       577
       +
                let span = Ptime.diff curr.Recur.start prev.Recur.start in

     

       578
       +
                let days_diff =

     

       579
       +
                  Ptime.Span.to_float_s span /. float_of_int day_seconds

     

       580
       +
                  |> Float.round |> int_of_float

     

       581
       +
                in

     

       582
       +
                Alcotest.(check int)

     

       583
       +
                  (Printf.sprintf "Days diff should be 7 days")

     

       584
       +
                  7 days_diff;

     

       585
       +
                curr)

     

       586
       +
              (List.hd instances) (List.tl instances))

     

       587
       +
       

     

       588
       +
       let test_long_interval ~fs () =

     

       589
       +
         let instances =

     

       590
       +
           test_recurrence_expansion ~fs "24_long_interval.ics" "2025-05-01"

     

       591
       +
             "2026-05-31" 4

     

       592
       +
         in

     

       593
       +
         verify_instance_spacing instances 100

     

       594
       +
       

     

       595
       +
       let test_leap_day ~fs () =

     

       596
       +
         let instances =

     

       597
       +
           test_recurrence_expansion ~fs "25_leap_day.ics" "2028-01-01" "2036-12-31" 3

     

       598
       +
         in

     

       599
       +
         Alcotest.(check int)

     

       600
       +
           "Should have 3 leap day instances" 3 (List.length instances);

     

       601
       +
         let all_leap_days =

     

       602
       +
           List.for_all

     

       603
       +
             (fun instance ->

     

       604
       +
               let (_, month, day), _ = Ptime.to_date_time instance.Recur.start in

     

       605
       +
               month = 2 && day = 29)

     

       606
       +
             instances

     

       607
       +
         in

     

       608
       +
         Alcotest.(check bool)

     

       609
       +
           "All instances should be on February 29" true all_leap_days;

     

       610
       +
         let years =

     

       611
       +
           List.map

     

       612
       +
             (fun instance ->

     

       613
       +
               let (year, _, _), _ = Ptime.to_date_time instance.Recur.start in

     

       614
       +
               year)

     

       615
       +
             instances

     

       616
       +
           |> List.sort_uniq compare

     

       617
       +
         in

     

       618
       +
         let expected_years = [ 2028; 2032; 2036 ] in

     

       619
       +
         Alcotest.(check (list int))

     

       620
       +
           "Should have instances in leap years 2028, 2032, and 2036" expected_years

     

       621
       +
           years

     

       622
       +
       

     

       623
       +
       let test_weekly_wkst ~fs () =

     

       624
       +
         let instances =

     

       625
       +
           test_recurrence_expansion ~fs "26_weekly_wkst.ics" "2025-05-01" "2025-05-31"

     

       626
       +
             4

     

       627
       +
         in

     

       628
       +
         (* Verify we get exactly 4 instances (COUNT=4) *)

     

       629
       +
         Alcotest.(check int)

     

       630
       +
           "Should have exactly 4 instances" 4 (List.length instances);

     

       631
       +
         verify_instance_spacing instances 7

     

       632
       +
       

     

       633
       +
       let test_monthly_nth_weekday ~fs () =

     

       634
       +
         let instances =

     

       635
       +
           test_recurrence_expansion ~fs "27_monthly_nth_weekday.ics" "2025-05-01"

     

       636
       +
             "2026-04-30" 11

     

       637
       +
         in

     

       638
       +
         let is_third_sunday instance =

     

       639
       +
           let date = instance.Recur.start in

     

       640
       +
           let is_sunday =

     

       641
       +
             match Ptime.weekday ~tz_offset_s:0 date with `Sun -> true | _ -> false

     

       642
       +
           in

     

       643
       +
           let (_, _, day), _ = Ptime.to_date_time date in

     

       644
       +
           is_sunday && day >= 15

     

       645
       +
           && day <= 21 (* Third Sunday is between 15th and 21st *)

     

       646
       +
         in

     

       647
       +
         let all_third_sundays = List.for_all is_third_sunday instances in

     

       648
       +
         Alcotest.(check bool)

     

       649
       +
           "All instances should be on the third Sunday of each month" true

     

       650
       +
           all_third_sundays

     

       651
       +
       

     

       652
       +
       let test_yearly_historical ~fs () =

     

       653
       +
         let instances =

     

       654
       +
           test_recurrence_expansion ~fs "28_yearly_historical.ics" "2000-01-01"

     

       655
       +
             "2011-01-01" 11

     

       656
       +
         in

     

       657
       +
         (* Verify instances are yearly and end by 2010-12-31 *)

     

       658
       +
         let all_before_2011 =

     

       659
       +
           List.for_all

     

       660
       +
             (fun instance ->

     

       661
       +
               let (year, _, _), _ = Ptime.to_date_time instance.Recur.start in

     

       662
       +
               year <= 2010)

     

       663
       +
             instances

     

       664
       +
         in

     

       665
       +
         Alcotest.(check bool)

     

       666
       +
           "All instances should be before 2011" true all_before_2011;

     

       667
       +
         ()

     

       668
       +
       

     

       669
       +
       let test_monthly_bymonth ~fs () =

     

       670
       +
         let instances =

     

       671
       +
           test_recurrence_expansion ~fs "29_monthly_bymonth.ics" "2025-01-01"

     

       672
       +
             "2026-12-31" 8

     

       673
       +
         in

     

       674
       +
         let is_specified_month instance =

     

       675
       +
           let date = instance.Recur.start in

     

       676
       +
           let (_, month, _), _ = Ptime.to_date_time date in

     

       677
       +
           month = 3 || month = 6 || month = 9 || month = 12 (* Mar, Jun, Sep, Dec *)

     

       678
       +
         in

     

       679
       +
         let all_specified_months = List.for_all is_specified_month instances in

     

       680
       +
         Alcotest.(check bool)

     

       681
       +
           "All instances should be in Mar, Jun, Sep, or Dec" true all_specified_months;

     

       682
       +
         ()

     

       683
       +
       

     

       684
       +
       let test_fourth_weekday ~fs () =

     

       685
       +
         let instances =

     

       686
       +
           test_recurrence_expansion ~fs "30_fourth_weekday.ics" "2025-01-01"

     

       687
       +
             "2035-12-31" 10

     

       688
       +
         in

     

       689
       +
         let is_fourth_sunday_in_october instance =

     

       690
       +
           let date = instance.Recur.start in

     

       691
       +
           let (_, month, day), _ = Ptime.to_date_time date in

     

       692
       +
           let is_sunday =

     

       693
       +
             match Ptime.weekday ~tz_offset_s:0 date with `Sun -> true | _ -> false

     

       694
       +
           in

     

       695
       +
           month = 10 && is_sunday && day >= 22

     

       696
       +
           && day <= 28 (* Fourth Sunday is between 22nd and 28th *)

     

       697
       +
         in

     

       698
       +
         let all_fourth_sundays = List.for_all is_fourth_sunday_in_october instances in

     

       699
       +
         Alcotest.(check bool)

     

       700
       +
           "All instances should be on the fourth Sunday in October" true

     

       701
       +
           all_fourth_sundays

     

       702
       +
       

     

       703
       +
       let recur_expand_tests ~fs =

     

       704
       +
         [

     

       705
       +
           ( "recurring events in date range",

     

       706
       +
             `Quick,

     

       707
       +
             test_recurring_events_in_date_range );

     

       708
       +
           ("daily recurrence", `Quick, test_daily ~fs);

     

       709
       +
           ("weekly recurrence", `Quick, test_weekly ~fs);

     

       710
       +
           ("monthly recurrence", `Quick, test_monthly ~fs);

     

       711
       +
           ("yearly recurrence", `Quick, test_yearly ~fs);

     

       712
       +
           ("every 2 days", `Quick, test_every_2_days ~fs);

     

       713
       +
           ("every 3 weeks", `Quick, test_every_3_weeks ~fs);

     

       714
       +
           ("bimonthly", `Quick, test_bimonthly ~fs);

     

       715
       +
           ("biennial", `Quick, test_biennial ~fs);

     

       716
       +
           ("daily with count=5", `Quick, test_daily_count5 ~fs);

     

       717
       +
           ("weekly with count=10", `Quick, test_weekly_count10 ~fs);

     

       718
       +
           ("daily until", `Quick, test_daily_until ~fs);

     

       719
       +
           ("weekly until", `Quick, test_weekly_until ~fs);

     

       720
       +
           ("weekly on Monday/Wednesday", `Quick, test_weekly_monday_wednesday ~fs);

     

       721
       +
           ("weekly on weekends", `Quick, test_weekly_weekends ~fs);

     

       722
       +
           ("monthly on specific day", `Quick, test_monthly_specific_day ~fs);

     

       723
       +
           ("monthly on second Monday", `Quick, test_monthly_second_monday ~fs);

     

       724
       +
           ("monthly on last day", `Quick, test_monthly_last_day ~fs);

     

       725
       +
           ("yearly on specific date", `Quick, test_yearly_specific_date ~fs);

     

       726
       +
           ("yearly on Mother's Day", `Quick, test_yearly_mothers_day ~fs);

     

       727
       +
           ("complex weekdays and months", `Quick, test_complex_weekdays_months ~fs);

     

       728
       +
           ("complex multiple month days", `Quick, test_complex_multiple_monthdays ~fs);

     

       729
       +
           ("with excluded dates", `Quick, test_with_exdate ~fs);

     

       730
       +
           ("DST transition handling", `Quick, test_dst_transition ~fs);

     

       731
       +
           ("long interval", `Quick, test_long_interval ~fs);

     

       732
       +
           ("leap day handling", `Quick, test_leap_day ~fs);

     

       733
       +
           ("weekly with week start", `Quick, test_weekly_wkst ~fs);

     

       734
       +
           ("monthly on nth weekday", `Quick, test_monthly_nth_weekday ~fs);

     

       735
       +
           ("yearly historical", `Quick, test_yearly_historical ~fs);

     

       736
       +
           ("monthly by month", `Quick, test_monthly_bymonth ~fs);

     

       737
       +
           ("fourth weekday", `Quick, test_fourth_weekday ~fs);

     

       738
       +
         ]

     

       739
       +
       

     

       740
       +
       let () =

     

       741
       +
         Eio_main.run @@ fun env ->

     

       742
       +
         let fs = Eio.Stdenv.fs env in

     

       743
       +
         Alcotest.run "Recur Expansion Tests"

     

       744
       +
           [ ("recur_expand", recur_expand_tests ~fs) ]