commit 188f2d89bf898b114ed0dcf656d5e1fb7f796acf · ryan.freumh.org/caledonia

CHANGELOG.md

···

       1
       1
       +
       

     

       2
       2
       +
       ### 0.4.0

     

       3
       3
       +
       

     

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

     

       1
       5
        
       

     

       2
       6
        
       ### 0.3.1

     

       3
       7

+5 -3

README.md

···

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

     

       2
       2
        
       

     

       3
       3
       -
       Caledonia is a command-line calendar client.

     

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

     

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

     

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

     

       5
       5
        
       

     

       6
       6
       -
       It has the `list`, `search`, `show`, `add`, `delete`, and `edit` subcommands, and has full timezone support.

     

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

     

       7
       7
        
       

     

       8
       8
        
       An example `list` invocation is,

     

       9
       9
        
       

     
···

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

     

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

     

       27
       27
        
       ```

     

       28
       28
       +
       

     

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

     

       28
       30
        
       

     

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

     

       30
       32

+13 -3

TODO.org

···

       4
       4
        
       - [x] timezones

     

       5
       5
        
       - [x] remove collection module

     

       6
       6
        
         - ref [[https://github.com/ocaml-ppx/ppxlib/issues/481]] cc patrick

     

       7
       7
       +
       - [ ] add timezone to call date functions and make it required

     

       7
       8
        
       - [ ] allow editing recurrence-ids

     

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

     

       9
       10
        
       - [ ] support specifying duration

     
···

       11
       12
        
         - day of the week

     

       12
       13
        
         - month names

     

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

     

       15
       15
       +
         - NB in emacs we use org-mode's datetime picker

     

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

     

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

     

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

     
···

       23
       25
        
       - [ ] support VALARMS

     

       24
       26
        
       - [ ] support VOTODS

     

       25
       27
        
       - [ ] support VCARDS

     

       26
       26
       -
       - [ ] server mode

     

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

     

       28
       28
       +
       - [x] server mode

     

       29
       29
       +
         - [x] hold =Event='s in-memory instead of parsing them for every =Query=

     

       28
       30
        
       - [ ] implement TUI front end with something like [[https://github.com/leostera/minttea][minttea]]

     

       29
       31
        
       - [ ] implement an emacs front end, like mu4e to mu

     

       30
       30
       -
       - [ ] parallel queries

     

       32
       32
       +
         - [x] listing, searching, querying

     

       33
       33
       +
         - [x] show details

     

       34
       34
       +
         - [x] show file

     

       35
       35
       +
         - [x] refresh

     

       36
       36
       +
         - [x] list possible calendars

     

       37
       37
       +
         - [x] add functions and bindings to change query parameters on the fly

     

       38
       38
       +
         - [ ] timezone support

     

       39
       39
       +
           - [ ] check the date module

     

       40
       40
       +
         - [ ] support adding, deleting, and editing events

+10 -3

bin/add_cmd.ml

···

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

     

       14
       14
        
         in

     

       15
       15
        
         let* end_ =

     

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

     

       16
       17
        
           let end_date =

     

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

     

       18
       18
        
             match (end_date, end_time) with

     

       19
       19
        
             | None, Some _ -> start_date

     

       20
       20
       +
             | _ -> end_date

     

       21
       21
       +
           in

     

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

     

       23
       23
       +
           let end_date =

     

       24
       24
       +
             match (start_date, end_date) with

     

       25
       25
       +
             | Some _, None -> start_date

     

       20
       26
        
             | _ -> end_date

     

       21
       27
        
           in

     

       22
       28
        
           let end_timezone =

     
···

       40
       46
        
             ~calendar_dir_path:(Calendar_dir.get_path calendar_dir)

     

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

     

       42
       48
        
         in

     

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

     

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

     

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

     

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

     

       45
       52
        
         Ok ()

     

       46
       53
        
       

     

       47
       54
        
       let cmd ~fs calendar_dir =

     

       48
       55
        
         let run summary start_date start_time end_date end_time location description

     

       49
       49
       -
             recur calendar_name timezone end_timezone =

     

       56
       56
       +
             recur calendar_name timezone end_timezone () =

     

       50
       57
        
           match

     

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

     

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

+7 -6

bin/delete_cmd.ml

···

       3
       3
        
       

     

       4
       4
        
       let run ~event_id ~fs calendar_dir =

     

       5
       5
        
         let ( let* ) = Result.bind in

     

       6
       6
       -
         let filter = Query.with_id event_id in

     

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

     

       6
       6
       +
         let filter = Event.with_id event_id in

     

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

     

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

     

       8
       9
        
         let* event =

     

       9
       9
       -
           match results with

     

       10
       10
       +
           match events with

     

       10
       11
        
           | [ event ] -> Ok event

     

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

     

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

     

       13
       14
        
         in

     

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

     

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

     

       15
       16
        
         match result with

     

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

     

       17
       17
       -
         | Ok () ->

     

       18
       18
       +
         | Ok _ ->

     

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

     

       19
       20
        
             Ok ()

     

       20
       21
        
       

     
···

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

     

       24
       25
        
       

     

       25
       26
        
       let cmd ~fs calendar_dir =

     

       26
       26
       -
         let run event_id =

     

       27
       27
       +
         let run event_id () =

     

       27
       28
        
           match run ~event_id ~fs calendar_dir with

     

       28
       29
        
           | Error (`Msg msg) ->

     

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

+5 -2

bin/dune

···

       14
       14
        
         ptime.clock.os

     

       15
       15
        
         eio

     

       16
       16
        
         eio_main

     

       17
       17
       -
         timere)

     

       17
       17
       +
         timere

     

       18
       18
       +
         sexplib

     

       19
       19
       +
         sexplib.unix)

     

       18
       20
        
        (modules

     

       19
       21
        
         main

     

       20
       22
        
         query_args

     
···

       24
       26
        
         show_cmd

     

       25
       27
        
         add_cmd

     

       26
       28
        
         delete_cmd

     

       27
       27
       -
         edit_cmd))

     

       29
       29
       +
         edit_cmd

     

       30
       30
       +
         server_cmd))

+5 -4

bin/edit_cmd.ml

···

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

     

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

     

       7
       7
        
         let ( let* ) = Result.bind in

     

       8
       8
       -
         let filter = Query.with_id event_id in

     

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

     

       8
       8
       +
         let filter = Event.with_id event_id in

     

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

     

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

     

       10
       11
        
         let* event =

     

       11
       12
        
           match results with

     

       12
       13
        
           | [ event ] -> Ok event

     
···

       39
       40
        
         let* modifed_event =

     

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

     

       41
       42
        
         in

     

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

     

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

     

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

     

       44
       45
        
         Ok ()

     

       45
       46
        
       

     
···

       49
       50
        
       

     

       50
       51
        
       let cmd ~fs calendar_dir =

     

       51
       52
        
         let run event_id summary start_date start_time end_date end_time location

     

       52
       52
       -
             description recur timezone end_timezone =

     

       53
       53
       +
             description recur timezone end_timezone () =

     

       53
       54
        
           match

     

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

     

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

+8 -9

bin/list_cmd.ml

···

       41
       41
        
               | Some f, None ->

     

       42
       42
        
                   let one_month_later = Date.add_months f 1 in

     

       43
       43
        
                   Ok (Some f, one_month_later)

     

       44
       44
       -
               | None, Some t ->

     

       45
       45
       -
                   let today_date = !Date.get_today ~tz () in

     

       46
       46
       -
                   Ok (Some today_date, Date.to_end_of_day t)

     

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

     

       47
       45
        
               | None, None ->

     

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

     

       49
       47
        
                   let one_month_later = Date.add_months today_date 1 in

     
···

       52
       50
        
         let filter =

     

       53
       51
        
           match calendars with

     

       54
       52
        
           | [] -> None

     

       55
       55
       -
           | calendar -> Some (Query.in_calendars calendar)

     

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

     

       56
       54
        
         in

     

       57
       55
        
         let comparator = Query_args.create_event_comparator sort in

     

       58
       58
       -
         let* results =

     

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

     

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

     

       57
       57
       +
         let events =

     

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

     

       60
       59
        
         in

     

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

     

       62
       62
       -
         else print_endline (Event.format_events ~format ~tz results);

     

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

     

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

     

       63
       62
        
         Ok ()

     

       64
       63
        
       

     

       65
       64
        
       let cmd ~fs calendar_dir =

     

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

     

       67
       67
       -
             timezone sort =

     

       66
       66
       +
             timezone sort () =

     

       68
       67
        
           match

     

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

     

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

+4 -3

bin/main.ml

···

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

     

       2
       2
       -
       

     

       3
       1
        
       open Cmdliner

     

       4
       2
        
       

     

       5
       3
        
       let list_cmd = List_cmd.cmd

     
···

       8
       6
        
       let add_cmd = Add_cmd.cmd

     

       9
       7
        
       let delete_cmd = Delete_cmd.cmd

     

       10
       8
        
       let edit_cmd = Edit_cmd.cmd

     

       9
       9
       +
       let server_cmd = Server_cmd.cmd

     

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

     

       12
       11
        
       let version = "%%VERSION%%"

     

       13
       12
        
       

     
···

       47
       46
        
                      add_cmd ~fs calendar_dir;

     

       48
       47
        
                      edit_cmd ~fs calendar_dir;

     

       49
       48
        
                      delete_cmd ~fs calendar_dir;

     

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

     

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

     

       50
       51
        
                    ])

     

       51
       52
        
             with

     

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

     

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

     

       53
       54
        
             | Ok _ -> 0

     

       54
       55
        
             | Error _ -> 1)

     

       55
       56

+18 -17

bin/search_cmd.ml

···

       47
       47
        
         in

     

       48
       48
        
         (match calendar with

     

       49
       49
        
         | [] -> ()

     

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

     

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

     

       51
       51
        
         (match query_text with

     

       52
       52
        
         | Some text ->

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       57
       57
        
               filters :=

     

       58
       58
       -
                 Query.or_filter

     

       58
       58
       +
                 Event.or_filter

     

       59
       59
        
                   [

     

       60
       60
       -
                     Query.summary_contains text;

     

       61
       61
       -
                     Query.description_contains text;

     

       62
       62
       -
                     Query.location_contains text;

     

       60
       60
       +
                     Event.summary_contains text;

     

       61
       61
       +
                     Event.description_contains text;

     

       62
       62
       +
                     Event.location_contains text;

     

       63
       63
        
                   ]

     

       64
       64
        
                 :: !filters

     

       65
       65
        
         | None -> ());

     

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

     

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

     

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

     

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

     

       68
       68
        
         (match id with

     

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

     

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

     

       70
       70
        
         | None -> ());

     

       71
       71
       -
         let filter = Query.and_filter !filters in

     

       71
       71
       +
         let filter = Event.and_filter !filters in

     

       72
       72
        
         let comparator = Query_args.create_event_comparator sort in

     

       73
       73
       -
         let* results =

     

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

     

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

     

       74
       74
       +
         let events =

     

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

     

       75
       76
        
         in

     

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

     

       77
       77
       -
         else print_endline (Event.format_events ~tz ~format results);

     

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

     

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

     

       78
       79
        
         Ok ()

     

       79
       80
        
       

     

       80
       81
        
       let query_text_arg =

     
···

       110
       111
        
       let cmd ~fs calendar_dir =

     

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

     

       112
       113
        
             location id today tomorrow week month recurring non_recurring timezone

     

       113
       113
       -
             sort =

     

       114
       114
       +
             sort () =

     

       114
       115
        
           match

     

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

     

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

+85

bin/server_cmd.ml

···

       1
       1
       +
       open Eio

     

       2
       2
       +
       open Cmdliner

     

       3
       3
       +
       open Caledonia_lib

     

       4
       4
       +
       open Caledonia_lib.Sexp

     

       5
       5
       +
       

     

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

     

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

     

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

     

       9
       9
       +
         

     

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

     

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

     

       12
       12
       +
         

     

       13
       13
       +
         try

     

       14
       14
       +
           while true do

     

       15
       15
       +
             let line = Buf_read.line reader in

     

       16
       16
       +
             let response =

     

       17
       17
       +
               try

     

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

     

       19
       19
       +
                 let request = Sexp.request_of_sexp sexp in

     

       20
       20
       +
                 match request with

     

       21
       21
       +
                 | ListCalendars ->

     

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

     

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

     

       24
       24
       +
                 | Refresh ->

     

       25
       25
       +
                     (* Reload events from disk *)

     

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

     

       27
       27
       +
                     (* Return an empty response *)

     

       28
       28
       +
                     Ok (sexp_of_response (Ok Empty))

     

       29
       29
       +
                 | Query query_req ->

     

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

     

       31
       31
       +
                       generate_query_params query_req

     

       32
       32
       +
                     in

     

       33
       33
       +
                     let* events = !mutable_events in

     

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

     

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

     

       36
       36
       +
               with

     

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

     

       38
       38
       +
                   let msg =

     

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

     

       40
       40
       +
                       (to_string bad_sexp)

     

       41
       41
       +
                   in

     

       42
       42
       +
                   Ok (sexp_of_response (Error msg))

     

       43
       43
       +
               | Failure msg ->

     

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

     

       45
       45
       +
               | exn ->

     

       46
       46
       +
                   let msg =

     

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

     

       48
       48
       +
                   in

     

       49
       49
       +
                   Ok (sexp_of_response (Error msg))

     

       50
       50
       +
             in

     

       51
       51
       +
             let response_line =

     

       52
       52
       +
               to_string

     

       53
       53
       +
                 (match response with

     

       54
       54
       +
                 | Ok r -> r

     

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

     

       56
       56
       +
             in

     

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

     

       58
       58
       +
           done

     

       59
       59
       +
         with End_of_file -> ()

     

       60
       60
       +
       

     

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

     

       62
       62
       +
         let run () =

     

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

     

       64
       64
       +
           0

     

       65
       65
       +
         in

     

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

     

       67
       67
       +
       

     

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

     

       69
       69
       +
         let man =

     

       70
       70
       +
           [

     

       71
       71
       +
             `S Manpage.s_description;

     

       72
       72
       +
             `P

     

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

     

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

     

       75
       75
       +
                line) to stdout.";

     

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

     

       77
       77
       +
             `P

     

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

     

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

     

       80
       80
       +
             `S Manpage.s_examples;

     

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

     

       82
       82
       +
           ]

     

       83
       83
       +
         in

     

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

     

       85
       85
       +
         Cmd.v info term

+4 -3

bin/show_cmd.ml

···

       3
       3
        
       

     

       4
       4
        
       let run ~event_id ~format ~fs calendar_dir =

     

       5
       5
        
         let ( let* ) = Result.bind in

     

       6
       6
       -
         let filter = Query.with_id event_id in

     

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

     

       6
       6
       +
         let filter = Event.with_id event_id in

     

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

     

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

     

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

     

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

     

       10
       11
        
         Ok ()

     
···

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

     

       22
       23
        
       

     

       23
       24
        
       let cmd ~fs calendar_dir =

     

       24
       24
       -
         let run event_id format =

     

       25
       25
       +
         let run event_id format () =

     

       25
       26
        
           match run ~event_id ~format ~fs calendar_dir with

     

       26
       27
        
           | Error (`Msg msg) ->

     

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

+1 -1

caledonia.opam

···

       1
       1
        
       opam-version: "2.0"

     

       2
       2
       -
       version: "0.3.0"

     

       2
       2
       +
       version: "0.4.0"

     

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

     

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

     

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

+2 -2

dune-project

···

       1
       1
        
       (lang dune 3.4)

     

       2
       2
        
       (name caledonia)

     

       3
       3
       -
       (version 0.3.0)

     

       4
       4
       -
       (using directory-targets 0.1)
     

       3
       3
       +
       (version 0.4.0)

     

       4
       4
       +
       (using directory-targets 0.1)

+822

emacs/caledonia.el

···

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

     

       2
       2
       +
       

     

       3
       3
       +
       ;; Copyright (C) 2025 Ryan Gibb

     

       4
       4
       +
       

     

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

     

       6
       6
       +
       ;; Version: 0.4

     

       7
       7
       +
       ;; Package-Requires: ((emacs "27.1"))

     

       8
       8
       +
       ;; Keywords: calendar, caledonia

     

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

     

       10
       10
       +
       

     

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

     

       12
       12
       +
       

     

       13
       13
       +
       ;;; Commentary:

     

       14
       14
       +
       

     

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

     

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

     

       17
       17
       +
       

     

       18
       18
       +
       ;;; Code:

     

       19
       19
       +
       

     

       20
       20
       +
       (require 'cl-lib)

     

       21
       21
       +
       (require 'calendar)

     

       22
       22
       +
       (require 'pulse nil t)

     

       23
       23
       +
       (require 'org)

     

       24
       24
       +
       

     

       25
       25
       +
       (defgroup caledonia nil

     

       26
       26
       +
         "Interface to Caledonia calendar client."

     

       27
       27
       +
         :group 'calendar

     

       28
       28
       +
         :prefix "caledonia-")

     

       29
       29
       +
       

     

       30
       30
       +
       (defcustom caledonia-executable "caled"

     

       31
       31
       +
         "Path to the Caledonia executable."

     

       32
       32
       +
         :type 'string

     

       33
       33
       +
         :group 'caledonia)

     

       34
       34
       +
       

     

       35
       35
       +
       (defface caledonia-calendar-name-face

     

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

     

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

     

       38
       38
       +
         :group 'caledonia)

     

       39
       39
       +
       

     

       40
       40
       +
       (defface caledonia-date-face

     

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

     

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

     

       43
       43
       +
         :group 'caledonia)

     

       44
       44
       +
       

     

       45
       45
       +
       (defface caledonia-summary-face

     

       46
       46
       +
         '((t :inherit default))

     

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

     

       48
       48
       +
         :group 'caledonia)

     

       49
       49
       +
       

     

       50
       50
       +
       (defface caledonia-location-face

     

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

     

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

     

       53
       53
       +
         :group 'caledonia)

     

       54
       54
       +
       

     

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

     

       56
       56
       +
         "Column width for the Calendar entry."

     

       57
       57
       +
         :type 'natnum)

     

       58
       58
       +
       

     

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

     

       60
       60
       +
         "Column width for the Start entry."

     

       61
       61
       +
         :type 'natnum)

     

       62
       62
       +
       

     

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

     

       64
       64
       +
         "Column width for the End entry."

     

       65
       65
       +
         :type 'natnum)

     

       66
       66
       +
       

     

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

     

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

     

       69
       69
       +
         :type 'string

     

       70
       70
       +
         :group 'caledonia)

     

       71
       71
       +
       

     

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

     

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

     

       74
       74
       +
         :type 'string

     

       75
       75
       +
         :group 'caledonia)

     

       76
       76
       +
       

     

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

     

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

     

       79
       79
       +
         :type 'string

     

       80
       80
       +
         :group 'caledonia)

     

       81
       81
       +
       

     

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

     

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

     

       84
       84
       +
         :type 'string

     

       85
       85
       +
         :group 'caledonia)

     

       86
       86
       +
       

     

       87
       87
       +
       ;; Define histories for input fields

     

       88
       88
       +
       

     

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

     

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

     

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

     

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

     

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

     

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

     

       95
       95
       +
       (defvar caledonia-id-history nil "History for event ID inputs.")

     

       96
       96
       +
       (defvar caledonia-limit-history nil "History for limit inputs.")

     

       97
       97
       +
       (defvar caledonia-search-prompt-history nil "History for search prompt inputs.")

     

       98
       98
       +
       

     

       99
       99
       +
       ;; Internal variables

     

       100
       100
       +
       

     

       101
       101
       +
       (defvar caledonia--events-buffer "*Caledonia Events*"

     

       102
       102
       +
         "Buffer name for displaying Caledonia events.")

     

       103
       103
       +
       (defvar caledonia--details-buffer "*Caledonia Event Details*"

     

       104
       104
       +
         "Buffer name for displaying Caledonia event details.")

     

       105
       105
       +
       (defvar caledonia--server-process nil

     

       106
       106
       +
         "The persistent Caledonia server process.")

     

       107
       107
       +
       (defvar caledonia--server-buffer-name "*caledonia-server-io*"

     

       108
       108
       +
         "Buffer for server process I/O.")

     

       109
       109
       +
       (defvar caledonia--response-line nil

     

       110
       110
       +
         "Last response line received.")

     

       111
       111
       +
       (defvar caledonia--response-flag nil

     

       112
       112
       +
         "Flag set when response is received.")

     

       113
       113
       +
       (defvar-local caledonia--current-query nil

     

       114
       114
       +
         "The current query parameters being displayed in this buffer.")

     

       115
       115
       +
       

     

       116
       116
       +
       ;; API functions

     

       117
       117
       +
       

     

       118
       118
       +
       (defvar caledonia--server-line-buffer "")

     

       119
       119
       +
       

     

       120
       120
       +
       (defun caledonia--server-filter (process output)

     

       121
       121
       +
         ;; Append to the ongoing buffer for logging/debugging

     

       122
       122
       +
         (when (buffer-live-p (process-buffer process))

     

       123
       123
       +
           (with-current-buffer (process-buffer process)

     

       124
       124
       +
             (goto-char (point-max))

     

       125
       125
       +
             (insert output)))

     

       126
       126
       +
         ;; Append new output to line buffer

     

       127
       127
       +
         (setq caledonia--server-line-buffer (concat caledonia--server-line-buffer output))

     

       128
       128
       +
         ;; Extract full lines

     

       129
       129
       +
         (let ((lines (split-string caledonia--server-line-buffer "\n")))

     

       130
       130
       +
           ;; Keep the last line (possibly incomplete) for next round

     

       131
       131
       +
           (setq caledonia--server-line-buffer (car (last lines)))

     

       132
       132
       +
           ;; Process all complete lines

     

       133
       133
       +
           (dolist (line (butlast lines))

     

       134
       134
       +
             (when (and (not caledonia--response-flag)

     

       135
       135
       +
                        (not (string-empty-p line)))

     

       136
       136
       +
               (setq caledonia--response-line line)

     

       137
       137
       +
               (setq caledonia--response-flag t)))))

     

       138
       138
       +
       

     

       139
       139
       +
       (defun caledonia--server-sentinel (process event)

     

       140
       140
       +
         (message "Caledonia Server process event: %s (%s)" process event)

     

       141
       141
       +
         (setq caledonia--server-process nil))

     

       142
       142
       +
       

     

       143
       143
       +
       (defun caledonia--ensure-server-running ()

     

       144
       144
       +
         (unless (and caledonia--server-process (process-live-p caledonia--server-process))

     

       145
       145
       +
           (message "Caledonia  Starting server...")

     

       146
       146
       +
           (setq caledonia--server-process

     

       147
       147
       +
                 (start-process "caledonia-server"

     

       148
       148
       +
                                (get-buffer-create caledonia--server-buffer-name)

     

       149
       149
       +
                                caledonia-executable

     

       150
       150
       +
                                "server"))

     

       151
       151
       +
           (unless (and caledonia--server-process (process-live-p caledonia--server-process))

     

       152
       152
       +
             (error "Caledonia  Failed to start server process."))

     

       153
       153
       +
           (set-process-filter caledonia--server-process #'caledonia--server-filter)

     

       154
       154
       +
           (set-process-sentinel caledonia--server-process #'caledonia--server-sentinel)

     

       155
       155
       +
           (message "Caledonia  Server started.")))

     

       156
       156
       +
       

     

       157
       157
       +
       (defun caledonia--send-request (request-str)

     

       158
       158
       +
         (caledonia--ensure-server-running)

     

       159
       159
       +
         (setq caledonia--response-line nil)

     

       160
       160
       +
         (setq caledonia--response-flag nil)

     

       161
       161
       +
         (process-send-string caledonia--server-process (concat request-str "\n"))

     

       162
       162
       +
         ;; Wait for response

     

       163
       163
       +
         (let ((start-time (current-time)))

     

       164
       164
       +
           (while (and (not caledonia--response-flag)

     

       165
       165
       +
                       (< (time-to-seconds (time-since start-time)) 5) ; 5 sec timeout

     

       166
       166
       +
                       (process-live-p caledonia--server-process))

     

       167
       167
       +
             (accept-process-output caledonia--server-process 0 100000))) ; Wait 100ms

     

       168
       168
       +
         (unless caledonia--response-flag

     

       169
       169
       +
           (error "Caledonia  Timeout or server died waiting for response."))

     

       170
       170
       +
         (condition-case err

     

       171
       171
       +
             (let ((response-sexp (read caledonia--response-line)))

     

       172
       172
       +
               (unless (and (listp response-sexp) (memq (car response-sexp) '(Ok Error)))

     

       173
       173
       +
                 (error "Caledonia  Invalid response format: %S" response-sexp))

     

       174
       174
       +
               (if (eq (car response-sexp) 'Error)

     

       175
       175
       +
                   (error "Caledonia Server Error: %s" (cadr response-sexp))

     

       176
       176
       +
                 ;; Return the (Ok ...) payload

     

       177
       177
       +
                 (cadr response-sexp)))

     

       178
       178
       +
           (error (error "Caledonia Failed to parse response line: %s"

     

       179
       179
       +
                         caledonia--response-line (error-message-string err)))))

     

       180
       180
       +
       

     

       181
       181
       +
       (defun caledonia--get-events (event-payload)

     

       182
       182
       +
         "Parse SEXP-STRING of structure (Events (events...))"

     

       183
       183
       +
         (if (and (listp event-payload) (eq (car event-payload) 'Events))

     

       184
       184
       +
             (let ((event-list (cadr event-payload)))

     

       185
       185
       +
               event-list)

     

       186
       186
       +
           (error

     

       187
       187
       +
            (message "Failed to parse Caledonia output: %s" (error-message-string err))

     

       188
       188
       +
            nil)))

     

       189
       189
       +
       

     

       190
       190
       +
       ;; UI functions

     

       191
       191
       +
       

     

       192
       192
       +
       (defun caledonia--format-timestamp (iso-string &optional format)

     

       193
       193
       +
         "Format ISO-8601 time string to human-readable format.

     

       194
       194
       +
       FORMAT defaults to \"%Y-%m-%d %H:%M\" if not specified."

     

       195
       195
       +
         (let* ((parsed (parse-time-string iso-string))

     

       196
       196
       +
                (time (apply #'encode-time

     

       197
       197
       +
                             (append (cl-subseq parsed 0 6) (list nil -1)))))

     

       198
       198
       +
           (format-time-string (or format "%Y-%m-%d %H:%M") time)))

     

       199
       199
       +
       

     

       200
       200
       +
       (defun caledonia--get-key (key event)

     

       201
       201
       +
         "Get KEY from EVENT as a string."

     

       202
       202
       +
         (let ((value (cadr (assoc key event))))

     

       203
       203
       +
           (cond

     

       204
       204
       +
            ((null value) nil)

     

       205
       205
       +
            ((stringp value) value)

     

       206
       206
       +
            ((symbolp value) (symbol-name value)))))

     

       207
       207
       +
       

     

       208
       208
       +
       (defun caledonia--tabulated-list-entries (events)

     

       209
       209
       +
         "Convert EVENTS for a format suitable for showing via a tabulated-list-mode'."

     

       210
       210
       +
         (let ((max-calendar-width 0)

     

       211
       211
       +
               (max-start-width 0)

     

       212
       212
       +
               (max-end-width 0)

     

       213
       213
       +
               (tabulated-list-entries nil))

     

       214
       214
       +
           ;; first pass: calculate maximum widths

     

       215
       215
       +
           (dolist (event events)

     

       216
       216
       +
             (let* ((calendar (caledonia--get-key 'calendar event))

     

       217
       217
       +
                    (start (caledonia--get-key 'start event))

     

       218
       218
       +
                    (end (caledonia--get-key 'end event))

     

       219
       219
       +
                    (cal-str (if (not calendar) "unkown" calendar))

     

       220
       220
       +
                    (start-str (caledonia--format-timestamp start))

     

       221
       221
       +
                    (end-str (when end

     

       222
       222
       +
                               (caledonia--format-timestamp (format "%s" end)))))

     

       223
       223
       +
               (setq max-calendar-width (max max-calendar-width (length cal-str)))

     

       224
       224
       +
               (setq max-start-width (max max-start-width (+ (length start-str) 2)))

     

       225
       225
       +
               (setq max-end-width (max max-end-width (length end-str)))))

     

       226
       226
       +
           (setq caledonia-calendar-column-width  (max max-calendar-width (length "Calendar")))

     

       227
       227
       +
           (setq caledonia-start-column-width (max max-start-width (length "Start")))

     

       228
       228
       +
           (setq caledonia-end-column-width  (max max-end-width (length "End")))

     

       229
       229
       +
           ;; second pass: prepare tabulated-list entries with properties

     

       230
       230
       +
           (setq tabulated-list-entries

     

       231
       231
       +
                 (mapcar (lambda (event)

     

       232
       232
       +
                           (let* (

     

       233
       233
       +
                                  (id (caledonia--get-key 'id event))

     

       234
       234
       +
                                  (summary (caledonia--get-key 'summary event))

     

       235
       235
       +
                                  (start (caledonia--get-key 'start event))

     

       236
       236
       +
                                  (end (caledonia--get-key 'end event))

     

       237
       237
       +
                                  (location (caledonia--get-key 'location event))

     

       238
       238
       +
                                  (calendar (caledonia--get-key 'calendar event))

     

       239
       239
       +
                                  (start-str (caledonia--format-timestamp start))

     

       240
       240
       +
                                  (end-str (if end (caledonia--format-timestamp (format "%s" end)) ""))

     

       241
       241
       +
                                  (start-str (if end (format "%s -" start-str) start-str))

     

       242
       242
       +
                                  (location-str (if location (concat " @ " location) ""))

     

       243
       243
       +
                                  (cal-prop (propertize calendar 'face 'caledonia-calendar-name-face))

     

       244
       244
       +
                                  (start-prop (propertize start-str 'face 'caledonia-date-face))

     

       245
       245
       +
                                  (end-prop (propertize end-str 'face 'caledonia-date-face))

     

       246
       246
       +
                                  (summary-prop (propertize (concat summary location-str)

     

       247
       247
       +
                                                            'face 'caledonia-summary-face))

     

       248
       248
       +
                                  ;; Store the full event data as a text property for retrieval

     

       249
       249
       +
                                  (entry-id (propertize (format "%s" id) 'event-data event)))

     

       250
       250
       +
                             (list entry-id (vector cal-prop start-prop end-prop summary-prop))))

     

       251
       251
       +
                         events))

     

       252
       252
       +
           tabulated-list-entries))

     

       253
       253
       +
       

     

       254
       254
       +
       (defun caledonia--sort-calendar (A B)

     

       255
       255
       +
         "Sort function for calendar column."

     

       256
       256
       +
         (let ((a (aref (cadr A) 0))

     

       257
       257
       +
               (b (aref (cadr B) 0)))

     

       258
       258
       +
           (string< a b)))

     

       259
       259
       +
       

     

       260
       260
       +
       (defun caledonia--sort-start (A B)

     

       261
       261
       +
         "Sort function for date/time column."

     

       262
       262
       +
         (let ((a (aref (cadr A) 1))

     

       263
       263
       +
               (b (aref (cadr B) 1)))

     

       264
       264
       +
           (time-less-p (date-to-time a) (date-to-time b))))

     

       265
       265
       +
       

     

       266
       266
       +
       (defun caledonia--sort-end (A B)

     

       267
       267
       +
         "Sort function for date/time column."

     

       268
       268
       +
         (let ((a (aref (cadr A) 2))

     

       269
       269
       +
               (b (aref (cadr B) 2)))

     

       270
       270
       +
           (time-less-p (date-to-time a) (date-to-time b))))

     

       271
       271
       +
       

     

       272
       272
       +
       (defun caledonia--make-query (&optional query)

     

       273
       273
       +
         "Make a query with the QUERY S-expression.

     

       274
       274
       +
       If QUERY is nil, use the current query stored in `caledonia--current-query`."

     

       275
       275
       +
         (interactive)

     

       276
       276
       +
         (let* ((query-to-use (or query caledonia--current-query '()))  ;; Use current query if available

     

       277
       277
       +
                ;; Ensure to date is set if not present in query

     

       278
       278
       +
                (query-to-use (if (assq 'to query-to-use)

     

       279
       279
       +
                                  query-to-use

     

       280
       280
       +
                                (cons `(to ,caledonia-list-to-date) query-to-use)))

     

       281
       281
       +
                (request-str (format "(Query %s)" (prin1-to-string query-to-use)))

     

       282
       282
       +
                (payload (caledonia--send-request request-str))

     

       283
       283
       +
                (events (caledonia--get-events payload))

     

       284
       284
       +
                (entries (caledonia--tabulated-list-entries events)))

     

       285
       285
       +
           ;; Save this query for future refreshes if explicitly provided

     

       286
       286
       +
           (when query

     

       287
       287
       +
             (setq-local caledonia--current-query query-to-use))

     

       288
       288
       +
           (setq tabulated-list-entries entries))

     

       289
       289
       +
         (setq tabulated-list-format

     

       290
       290
       +
               `[("Calendar" ,caledonia-calendar-column-width caledonia--sort-calendar)

     

       291
       291
       +
                 ("Start" ,caledonia-start-column-width caledonia--sort-start)

     

       292
       292
       +
                 ("End" ,caledonia-end-column-width caledonia--sort-end)

     

       293
       293
       +
                 ("Summary" 0 t)])

     

       294
       294
       +
         (setq tabulated-list-sort-key (cons "Start" nil))

     

       295
       295
       +
         (tabulated-list-init-header)

     

       296
       296
       +
         (tabulated-list-print t))

     

       297
       297
       +
       

     

       298
       298
       +
       (defun caledonia--find-and-highlight-event-in-file (file event-id)

     

       299
       299
       +
         "Find EVENT-ID in FILE, position cursor, and highlight the event.

     

       300
       300
       +
       Return non-nil if the event was found."

     

       301
       301
       +
         (when (and file event-id)

     

       302
       302
       +
           (let ((id-str (format "%s" event-id))

     

       303
       303
       +
                 (found nil))

     

       304
       304
       +
             ;; Try to find and highlight iCalendar VEVENT block

     

       305
       305
       +
             (goto-char (point-min))

     

       306
       306
       +
             (when (and (string-match-p "\\.ics$" file)

     

       307
       307
       +
                        (search-forward (format "UID:%s" id-str) nil t))

     

       308
       308
       +
               ;; Found the UID in an ICS file, try to highlight the VEVENT block

     

       309
       309
       +
               (let ((uid-pos (match-beginning 0))

     

       310
       310
       +
                     (vevent-start nil)

     

       311
       311
       +
                     (vevent-end nil))

     

       312
       312
       +
                 ;; Find start of the VEVENT block

     

       313
       313
       +
                 (save-excursion

     

       314
       314
       +
                   (goto-char uid-pos)

     

       315
       315
       +
                   (if (search-backward "BEGIN:VEVENT" nil t)

     

       316
       316
       +
                       (setq vevent-start (match-beginning 0))

     

       317
       317
       +
                     (setq vevent-start uid-pos)))

     

       318
       318
       +
                 ;; Find end of the VEVENT block

     

       319
       319
       +
                 (save-excursion

     

       320
       320
       +
                   (goto-char uid-pos)

     

       321
       321
       +
                   (if (search-forward "END:VEVENT" nil t)

     

       322
       322
       +
                       (setq vevent-end (match-end 0))

     

       323
       323
       +
                     (setq vevent-end (line-end-position))))

     

       324
       324
       +
                 ;; Highlight the whole VEVENT block if found

     

       325
       325
       +
                 (when (and vevent-start vevent-end)

     

       326
       326
       +
                   (goto-char vevent-start)

     

       327
       327
       +
                   (caledonia--highlight-region vevent-start vevent-end)

     

       328
       328
       +
                   (recenter)

     

       329
       329
       +
                   (setq found t))))

     

       330
       330
       +
             (unless found

     

       331
       331
       +
               (message "Event ID not found in file"))

     

       332
       332
       +
             found)))

     

       333
       333
       +
       

     

       334
       334
       +
       (defun caledonia--display-event-details (event)

     

       335
       335
       +
         "Display details for EVENT in a separate buffer."

     

       336
       336
       +
         (let ((buf (get-buffer-create caledonia--details-buffer)))

     

       337
       337
       +
           (with-current-buffer buf

     

       338
       338
       +
             (let ((inhibit-read-only t))

     

       339
       339
       +
               (erase-buffer)

     

       340
       340
       +
               (special-mode)

     

       341
       341
       +
               (let* ((id (caledonia--get-key 'id event))

     

       342
       342
       +
                      (summary (caledonia--get-key 'summary event))

     

       343
       343
       +
                      (description (caledonia--get-key 'description event))

     

       344
       344
       +
                      (start (caledonia--get-key 'start event))

     

       345
       345
       +
                      (end (caledonia--get-key 'end event))

     

       346
       346
       +
                      (location (caledonia--get-key 'location event))

     

       347
       347
       +
                      (calendar (caledonia--get-key 'calendar event))

     

       348
       348
       +
                      (file (caledonia--get-key 'file event))

     

       349
       349
       +
                      (start-str (when start (caledonia--format-timestamp start)))

     

       350
       350
       +
                      (end-str (when end (caledonia--format-timestamp end))))

     

       351
       351
       +
                 (when id

     

       352
       352
       +
                   (insert (propertize "Summary: " 'face 'bold) summary "\n"))

     

       353
       353
       +
                 (when id

     

       354
       354
       +
                   (insert (propertize "ID: " 'face 'bold) id "\n"))

     

       355
       355
       +
                 (when calendar

     

       356
       356
       +
                   (insert (propertize "Calendar: " 'face 'bold) calendar "\n"))

     

       357
       357
       +
                 (when start-str

     

       358
       358
       +
                   (insert (propertize "Start: " 'face 'bold) start-str "\n"))

     

       359
       359
       +
                 (when end-str

     

       360
       360
       +
                   (insert (propertize "End: " 'face 'bold) end-str "\n"))

     

       361
       361
       +
                 (when location

     

       362
       362
       +
                   (insert (propertize "Location: " 'face 'bold) location "\n"))

     

       363
       363
       +
                 (when file

     

       364
       364
       +
                   (insert (propertize "File: " 'face 'bold)

     

       365
       365
       +
                           (propertize file 'face 'link

     

       366
       366
       +
                                       'mouse-face 'highlight

     

       367
       367
       +
                                       'help-echo "Click to open file with highlighting"

     

       368
       368
       +
                                       'keymap (let ((map (make-sparse-keymap))

     

       369
       369
       +
                                                     (event-copy event))

     

       370
       370
       +
                                                 (define-key map [mouse-1]

     

       371
       371
       +
                                                             (lambda ()

     

       372
       372
       +
                                                               (interactive)

     

       373
       373
       +
                                                               (let ((file-path file)

     

       374
       374
       +
                                                                     (id-val (caledonia--get-key 'id event-copy)))

     

       375
       375
       +
                                                                 (find-file file-path)

     

       376
       376
       +
                                                                 (caledonia--find-and-highlight-event-in-file

     

       377
       377
       +
                                                                  file-path id-val))))

     

       378
       378
       +
                                                 (define-key map (kbd "RET")

     

       379
       379
       +
                                                             (lambda ()

     

       380
       380
       +
                                                               (interactive)

     

       381
       381
       +
                                                               (let ((file-path file)

     

       382
       382
       +
                                                                     (id-val (caledonia--get-key 'id event-copy)))

     

       383
       383
       +
                                                                 (find-file file-path)

     

       384
       384
       +
                                                                 (caledonia--find-and-highlight-event-in-file

     

       385
       385
       +
                                                                  file-path id-val))))

     

       386
       386
       +
                                                 map))

     

       387
       387
       +
                           "\n"))

     

       388
       388
       +
                 (when description

     

       389
       389
       +
                   (insert "\n" (propertize "Description:" 'face 'bold) "\n"

     

       390
       390
       +
                           (propertize "------------" 'face 'bold) "\n"

     

       391
       391
       +
                           description "\n")))))

     

       392
       392
       +
           (switch-to-buffer-other-window buf)))

     

       393
       393
       +
       

     

       394
       394
       +
       (defun caledonia--highlight-region (start end)

     

       395
       395
       +
         "Highlight the region between START and END."

     

       396
       396
       +
         (when (fboundp 'pulse-momentary-highlight-region)

     

       397
       397
       +
           (pulse-momentary-highlight-region start end))

     

       398
       398
       +
         ;; Fallback for when pulse is not available

     

       399
       399
       +
         (unless (fboundp 'pulse-momentary-highlight-region)

     

       400
       400
       +
           (let ((overlay (make-overlay start end)))

     

       401
       401
       +
             (overlay-put overlay 'face 'highlight)

     

       402
       402
       +
             (run-with-timer 0.5 nil (lambda () (delete-overlay overlay))))))

     

       403
       403
       +
       

     

       404
       404
       +
       (defun caledonia--read-date-range ()

     

       405
       405
       +
         "Read a date range from the user with org-mode date picker integration.

     

       406
       406
       +
       Returns a cons cell (from-date . to-date).

     

       407
       407
       +
       The from-date can be nil to indicate no start date constraint."

     

       408
       408
       +
         (let (from to)

     

       409
       409
       +
           (setq from

     

       410
       410
       +
                 (if (y-or-n-p "Set a start date? ")

     

       411
       411
       +
                     (org-read-date nil nil nil "From date: " nil nil t)

     

       412
       412
       +
                   ; empty string differentiates from nil for optional args later on

     

       413
       413
       +
                   ""))

     

       414
       414
       +
           ;; Use org-mode's date picker for To date (must have a value)

     

       415
       415
       +
           (setq to (org-read-date nil nil nil "To date: " nil nil t))

     

       416
       416
       +
           (cons from to)))

     

       417
       417
       +
       

     

       418
       418
       +
       ;; Query parameter modification functions

     

       419
       419
       +
       

     

       420
       420
       +
       (defun caledonia-query-date-range ()

     

       421
       421
       +
         "Set the date range for the current calendar view."

     

       422
       422
       +
         (interactive)

     

       423
       423
       +
         (when (eq major-mode 'caledonia-mode)

     

       424
       424
       +
           (let* ((dates (caledonia--read-date-range

     

       425
       425
       +
                          "From date" "" 'caledonia-from-history

     

       426
       426
       +
                          "To date" "" 'caledonia-to-history))

     

       427
       427
       +
                  (from (car dates))

     

       428
       428
       +
                  (to (cdr dates))

     

       429
       429
       +
                  (current-query caledonia--current-query)

     

       430
       430
       +
                  (new-query (copy-tree current-query)))

     

       431
       431
       +
             ;; Update the query with the new date range

     

       432
       432
       +
             (setq new-query (assq-delete-all 'from new-query))

     

       433
       433
       +
             (setq new-query (assq-delete-all 'to new-query))

     

       434
       434
       +
             (when (and from (not (string-empty-p from)))

     

       435
       435
       +
               (push `(from ,from) new-query))

     

       436
       436
       +
             (when (and to (not (string-empty-p to)))

     

       437
       437
       +
               (push `(to ,to) new-query))

     

       438
       438
       +
             ;; Execute the updated query

     

       439
       439
       +
             (caledonia--make-query new-query))))

     

       440
       440
       +
       

     

       441
       441
       +
       (defun caledonia-query-calendars ()

     

       442
       442
       +
         "Set the calendars to filter by for the current calendar view.

     

       443
       443
       +
       Fetches available calendars from server to allow selection from a list."

     

       444
       444
       +
         (interactive)

     

       445
       445
       +
         (when (eq major-mode 'caledonia-mode)

     

       446
       446
       +
           (let* ((available-calendars

     

       447
       447
       +
                   (caledonia--send-request "ListCalendars"))

     

       448
       448
       +
                  (calendars-list

     

       449
       449
       +
                   (if (and (listp available-calendars)

     

       450
       450
       +
                            (eq (car available-calendars) 'Calendars))

     

       451
       451
       +
                       (cadr available-calendars)

     

       452
       452
       +
                     (progn

     

       453
       453
       +
                       (message "Failed to get calendar list from server")

     

       454
       454
       +
                       nil)))

     

       455
       455
       +
                  ;; Use completing-read-multiple to select from available calendars

     

       456
       456
       +
                  (selected-calendars

     

       457
       457
       +
                   (completing-read-multiple

     

       458
       458
       +
                    "Select calendars (comma-separated, empty for all): "

     

       459
       459
       +
                    ;; Use empty list if no calendars found

     

       460
       460
       +
                    (or calendars-list '())

     

       461
       461
       +
                    nil nil

     

       462
       462
       +
                    (let ((current-calendars (cdr (assq 'calendars caledonia--current-query))))

     

       463
       463
       +
                      (when current-calendars

     

       464
       464
       +
                        (mapconcat #'identity current-calendars ",")))

     

       465
       465
       +
                    'caledonia-calendars-history))

     

       466
       466
       +
                  (calendars (mapcar #'string-trim selected-calendars))

     

       467
       467
       +
                  (current-query caledonia--current-query)

     

       468
       468
       +
                  (new-query (copy-tree current-query)))

     

       469
       469
       +
             ;; Update the query with the new calendars

     

       470
       470
       +
             (setq new-query (assq-delete-all 'calendars new-query))

     

       471
       471
       +
             (when (and calendars (not (null calendars)))

     

       472
       472
       +
               (push `(calendars ,calendars) new-query))

     

       473
       473
       +
             ;; Execute the updated query

     

       474
       474
       +
             (caledonia--make-query new-query))))

     

       475
       475
       +
       

     

       476
       476
       +
       (defun caledonia-query-text ()

     

       477
       477
       +
         "Set the search text for the current calendar view."

     

       478
       478
       +
         (interactive)

     

       479
       479
       +
         (when (eq major-mode 'caledonia-mode)

     

       480
       480
       +
           (let* ((text (read-string "Search text (leave empty for no text search): "

     

       481
       481
       +
                                     nil 'caledonia-text-history))

     

       482
       482
       +
                  (search-in-str (when (and text (not (string-empty-p text)))

     

       483
       483
       +
                                   (read-string "Search in (summary,description,location - leave empty for all): "

     

       484
       484
       +
                                                nil 'caledonia-search-fields-history)))

     

       485
       485
       +
                  (search-in (when (and search-in-str (not (string-empty-p search-in-str)))

     

       486
       486
       +
                               (mapcar (lambda (field)

     

       487
       487
       +
                                         (intern (string-trim field)))

     

       488
       488
       +
                                       (split-string search-in-str "," t))))

     

       489
       489
       +
                  (current-query caledonia--current-query)

     

       490
       490
       +
                  (new-query (copy-tree current-query)))

     

       491
       491
       +
             ;; Update the query with the new text search parameters

     

       492
       492
       +
             (setq new-query (assq-delete-all 'text new-query))

     

       493
       493
       +
             (setq new-query (assq-delete-all 'search_in new-query))

     

       494
       494
       +
             (when (and text (not (string-empty-p text)))

     

       495
       495
       +
               (push `(text ,text) new-query))

     

       496
       496
       +
             (when search-in

     

       497
       497
       +
               (push `(search_in ,search-in) new-query))

     

       498
       498
       +
             ;; Execute the updated query

     

       499
       499
       +
             (caledonia--make-query new-query))))

     

       500
       500
       +
       

     

       501
       501
       +
       (defun caledonia-query-id ()

     

       502
       502
       +
         "Set the event ID to filter by for the current calendar view."

     

       503
       503
       +
         (interactive)

     

       504
       504
       +
         (when (eq major-mode 'caledonia-mode)

     

       505
       505
       +
           (let* ((id (read-string "Event ID (leave empty for all events): "

     

       506
       506
       +
                                   nil 'caledonia-id-history))

     

       507
       507
       +
                  (current-query caledonia--current-query)

     

       508
       508
       +
                  (new-query (copy-tree current-query)))

     

       509
       509
       +
             ;; Update the query with the new ID

     

       510
       510
       +
             (setq new-query (assq-delete-all 'id new-query))

     

       511
       511
       +
             (when (and id (not (string-empty-p id)))

     

       512
       512
       +
               (push `(id ,id) new-query))

     

       513
       513
       +
             ;; Execute the updated query

     

       514
       514
       +
             (caledonia--make-query new-query))))

     

       515
       515
       +
       

     

       516
       516
       +
       (defun caledonia-query-recurring ()

     

       517
       517
       +
         "Set whether to filter by recurring events for the current calendar view."

     

       518
       518
       +
         (interactive)

     

       519
       519
       +
         (when (eq major-mode 'caledonia-mode)

     

       520
       520
       +
           (let* ((recurring-str (completing-read "Recurring events (yes/no/all, leave empty for all): "

     

       521
       521
       +
                                                 '("" "yes" "no") nil nil nil))

     

       522
       522
       +
                  (recurring (cond ((string= recurring-str "yes") t)

     

       523
       523
       +
                                   ((string= recurring-str "no") nil)

     

       524
       524
       +
                                   (t nil)))

     

       525
       525
       +
                  (current-query caledonia--current-query)

     

       526
       526
       +
                  (new-query (copy-tree current-query)))

     

       527
       527
       +
             ;; Update the query with the recurring filter

     

       528
       528
       +
             (setq new-query (assq-delete-all 'recurring new-query))

     

       529
       529
       +
             (when (not (string-empty-p recurring-str))

     

       530
       530
       +
               (push `(recurring ,(if (string= recurring-str "yes") t nil)) new-query))

     

       531
       531
       +
             ;; Execute the updated query

     

       532
       532
       +
             (caledonia--make-query new-query))))

     

       533
       533
       +
       

     

       534
       534
       +
       (defun caledonia-query-limit ()

     

       535
       535
       +
         "Set the maximum number of events to show in the current calendar view."

     

       536
       536
       +
         (interactive)

     

       537
       537
       +
         (when (eq major-mode 'caledonia-mode)

     

       538
       538
       +
           (let* ((limit-str (read-string "Maximum events to show (leave empty for no limit): "

     

       539
       539
       +
                                          nil 'caledonia-limit-history))

     

       540
       540
       +
                  (limit (when (and limit-str (not (string-empty-p limit-str)))

     

       541
       541
       +
                           (string-to-number limit-str)))

     

       542
       542
       +
                  (current-query caledonia--current-query)

     

       543
       543
       +
                  (new-query (copy-tree current-query)))

     

       544
       544
       +
             ;; Update the query with the new limit

     

       545
       545
       +
             (setq new-query (assq-delete-all 'limit new-query))

     

       546
       546
       +
             (when limit

     

       547
       547
       +
               (push `(limit ,limit) new-query))

     

       548
       548
       +
             ;; Execute the updated query

     

       549
       549
       +
             (caledonia--make-query new-query))))

     

       550
       550
       +
       

     

       551
       551
       +
       (defun caledonia-query-timezone ()

     

       552
       552
       +
         "Set the timezone for the current calendar view."

     

       553
       553
       +
         (interactive)

     

       554
       554
       +
         (when (eq major-mode 'caledonia-mode)

     

       555
       555
       +
           (let* ((timezone-str (read-string "Timezone (e.g. Europe/London, leave empty for default): "

     

       556
       556
       +
                                             nil 'caledonia-timezone-history))

     

       557
       557
       +
                  (timezone (when (not (string-empty-p timezone-str)) timezone-str))

     

       558
       558
       +
                  (current-query caledonia--current-query)

     

       559
       559
       +
                  (new-query (copy-tree current-query)))

     

       560
       560
       +
             ;; Update the query with the new timezone

     

       561
       561
       +
             (setq new-query (assq-delete-all 'timezone new-query))

     

       562
       562
       +
             (when timezone

     

       563
       563
       +
               (push `(timezone ,timezone) new-query))

     

       564
       564
       +
             ;; Execute the updated query

     

       565
       565
       +
             (caledonia--make-query new-query))))

     

       566
       566
       +
       

     

       567
       567
       +
       ;; Buffer functions

     

       568
       568
       +
       

     

       569
       569
       +
       (defun caledonia-show-event ()

     

       570
       570
       +
         "Show details for the event at point in a separate buffer."

     

       571
       571
       +
         (interactive)

     

       572
       572
       +
         (when (eq major-mode 'caledonia-mode)

     

       573
       573
       +
           (let* ((id (tabulated-list-get-id))

     

       574
       574
       +
                  (event (when id (get-text-property 0 'event-data id))))

     

       575
       575
       +
             (if event

     

       576
       576
       +
                 (caledonia--display-event-details event)

     

       577
       577
       +
               (message "No event at point")))))

     

       578
       578
       +
       

     

       579
       579
       +
       (defun caledonia-open-event-file ()

     

       580
       580
       +
         "Open the file associated with the event at point.

     

       581
       581
       +
       If the file contains the event ID, the cursor will be positioned at that location."

     

       582
       582
       +
         (interactive)

     

       583
       583
       +
         (when (eq major-mode 'caledonia-mode)

     

       584
       584
       +
           (let* ((id (tabulated-list-get-id))

     

       585
       585
       +
                  (event (when id (get-text-property 0 'event-data id)))

     

       586
       586
       +
                  (file (when event (caledonia--get-key 'file event)))

     

       587
       587
       +
                  (event-id (when event (caledonia--get-key 'id event))))

     

       588
       588
       +
             (cond

     

       589
       589
       +
              ((not event)

     

       590
       590
       +
               (message "No event at point"))

     

       591
       591
       +
              ((not file)

     

       592
       592
       +
               (message "No file associated with this event"))

     

       593
       593
       +
              ((not (file-exists-p file))

     

       594
       594
       +
               (message "File does not exist: %s" file))

     

       595
       595
       +
              (t

     

       596
       596
       +
               (find-file file)

     

       597
       597
       +
               (caledonia--find-and-highlight-event-in-file file event-id))))))

     

       598
       598
       +
       

     

       599
       599
       +
       (defun caledonia-refresh ()

     

       600
       600
       +
         "Refresh calendar data from disk and update the current view.

     

       601
       601
       +
       This is useful when calendar files have been modified outside Emacs

     

       602
       602
       +
       (for example, by a sync program or direct file edits)."

     

       603
       603
       +
         (interactive)

     

       604
       604
       +
         (when (eq major-mode 'caledonia-mode)

     

       605
       605
       +
           ;; Send a refresh command to clear the server's cache

     

       606
       606
       +
           (caledonia--send-request "Refresh")

     

       607
       607
       +
           ;; Re-apply the current query to update the view

     

       608
       608
       +
           (when (string= (buffer-name) caledonia--events-buffer)

     

       609
       609
       +
             ;; Just use caledonia--make-query without args to use the stored query

     

       610
       610
       +
             (caledonia--make-query))))

     

       611
       611
       +
       

     

       612
       612
       +
       ;; Entry functions

     

       613
       613
       +
       

     

       614
       614
       +
       (defun caledonia-query ()

     

       615
       615
       +
         "Query events with interactive prompts for all filter parameters.

     

       616
       616
       +
       Opens a series of prompts to build a complete query and then displays the results.

     

       617
       617
       +
       After the initial query is displayed, you can further refine the results

     

       618
       618
       +
       using the caledonia-query-* family of functions."

     

       619
       619
       +
         (interactive)

     

       620
       620
       +
         (let* (

     

       621
       621
       +
               (dates (caledonia--read-date-range))

     

       622
       622
       +
               (from (car dates))

     

       623
       623
       +
               (to (cdr dates))

     

       624
       624
       +
               (timezone-str (read-string "Timezone (e.g. Europe/London, leave empty for default): "

     

       625
       625
       +
                                          nil 'caledonia-timezone-history))

     

       626
       626
       +
               (timezone (when (not (string-empty-p timezone-str)) timezone-str))

     

       627
       627
       +
               (available-calendars

     

       628
       628
       +
                (caledonia--send-request "ListCalendars"))

     

       629
       629
       +
               (calendars-list

     

       630
       630
       +
                (if (and (listp available-calendars)

     

       631
       631
       +
                         (eq (car available-calendars) 'Calendars))

     

       632
       632
       +
                    (cadr available-calendars)

     

       633
       633
       +
                  (progn

     

       634
       634
       +
                    (message "Failed to get calendar list from server")

     

       635
       635
       +
                    nil)))

     

       636
       636
       +
               (selected-calendars

     

       637
       637
       +
                (completing-read-multiple

     

       638
       638
       +
                 "Select calendars (comma-separated, empty for all): "

     

       639
       639
       +
                 (or calendars-list '()) nil nil nil 'caledonia-calendars-history))

     

       640
       640
       +
               (calendars (mapcar #'string-trim selected-calendars))

     

       641
       641
       +
               (text (read-string "Search text (leave empty for no text search): "

     

       642
       642
       +
                                  nil 'caledonia-text-history))

     

       643
       643
       +
               (search-in-str (when (and text (not (string-empty-p text)))

     

       644
       644
       +
                                (read-string "Search in (summary,description,location - leave empty for all): "

     

       645
       645
       +
                                             nil 'caledonia-search-fields-history)))

     

       646
       646
       +
               (search-in (when (and search-in-str (not (string-empty-p search-in-str)))

     

       647
       647
       +
                            (mapcar (lambda (field)

     

       648
       648
       +
                                      (intern (string-trim field)))

     

       649
       649
       +
                                    (split-string search-in-str "," t))))

     

       650
       650
       +
               (id (read-string "Event ID (leave empty for all events): "

     

       651
       651
       +
                                nil 'caledonia-id-history))

     

       652
       652
       +
               (recurring (completing-read "Recurring events (yes/no/all, leave empty for all): "

     

       653
       653
       +
                                              '("" "yes" "no") nil nil nil))

     

       654
       654
       +
               (limit-str (read-string "Maximum events to show (leave empty for no limit): "

     

       655
       655
       +
                                       nil 'caledonia-limit-history))

     

       656
       656
       +
               (limit (when (and limit-str (not (string-empty-p limit-str)))

     

       657
       657
       +
                        (string-to-number limit-str)))

     

       658
       658
       +
               (query nil))

     

       659
       659
       +
           ;; Build query based on parameters

     

       660
       660
       +
           (when (and from (not (string-empty-p from)))

     

       661
       661
       +
             (push `(from ,from) query))

     

       662
       662
       +
           (when (and to (not (string-empty-p to)))

     

       663
       663
       +
             (push `(to ,to) query))

     

       664
       664
       +
           (when timezone

     

       665
       665
       +
             (push `(timezone ,timezone) query))

     

       666
       666
       +
           (when calendars

     

       667
       667
       +
             (push `(calendars ,calendars) query))

     

       668
       668
       +
           (when (and text (not (string-empty-p text)))

     

       669
       669
       +
             (push `(text ,text) query))

     

       670
       670
       +
           (when search-in

     

       671
       671
       +
             (push `(search_in ,search-in) query))

     

       672
       672
       +
           (when (and id (not (string-empty-p id)))

     

       673
       673
       +
             (push `(id ,id) query))

     

       674
       674
       +
           (when (not (string-empty-p recurring))

     

       675
       675
       +
             (push `(recurring ,(if (string= recurring "yes") t nil)) query))

     

       676
       676
       +
           (when limit

     

       677
       677
       +
             (push `(limit ,limit) query))

     

       678
       678
       +
           ;; Create buffer and execute query

     

       679
       679
       +
           (let ((buffer (get-buffer-create caledonia--events-buffer)))

     

       680
       680
       +
             (with-current-buffer buffer

     

       681
       681
       +
               ;; Clear the buffer and reset it

     

       682
       682
       +
               (let ((inhibit-read-only t))

     

       683
       683
       +
                 (erase-buffer))

     

       684
       684
       +
               ;; Activate our mode and make the query

     

       685
       685
       +
               (caledonia-mode)

     

       686
       686
       +
               (caledonia--make-query query)

     

       687
       687
       +
               (switch-to-buffer buffer)))))

     

       688
       688
       +
       

     

       689
       689
       +
       (defun caledonia-list (&optional from-date to-date)

     

       690
       690
       +
         "List calendar in a new buffer within the default date range.

     

       691
       691
       +
       FROM-DATE and TO-DATE override the default date range if provided.

     

       692
       692
       +
       TO-DATE is required and will use a default if not specified.

     

       693
       693
       +
       With prefix arg (C-u), prompts for the date range with an interactive calendar."

     

       694
       694
       +
         (interactive

     

       695
       695
       +
          (when current-prefix-arg

     

       696
       696
       +
            (let* ((dates (caledonia--read-date-range)))

     

       697
       697
       +
                   (list (car dates) (cdr dates)))))

     

       698
       698
       +
         (let ((buffer (get-buffer-create caledonia--events-buffer))

     

       699
       699
       +
               (from (or from-date caledonia-list-from-date))

     

       700
       700
       +
               ;; Ensure to date is always provided

     

       701
       701
       +
               (to (or (and to-date (not (string-empty-p to-date)) to-date)

     

       702
       702
       +
                       caledonia-list-to-date)))

     

       703
       703
       +
           (with-current-buffer buffer

     

       704
       704
       +
             ;; Clear the buffer and reset it

     

       705
       705
       +
             (let ((inhibit-read-only t))

     

       706
       706
       +
               (erase-buffer))

     

       707
       707
       +
             ;; Build the query

     

       708
       708
       +
             (let* ((query `((to ,to))))

     

       709
       709
       +
               ;; Add from date only if specified

     

       710
       710
       +
               (when (and from (not (string-empty-p from)))

     

       711
       711
       +
                 (setq query (append query `((from ,from)))))

     

       712
       712
       +
               ;; Activate our mode and make the query

     

       713
       713
       +
               (caledonia-mode)

     

       714
       714
       +
               (caledonia--make-query query)

     

       715
       715
       +
               (switch-to-buffer buffer)))))

     

       716
       716
       +
       

     

       717
       717
       +
       (defun caledonia-search (&optional expr from-date to-date)

     

       718
       718
       +
         "Search for query EXPR with optional FROM-DATE and TO-DATE.

     

       719
       719
       +
       This is an interactive function which asks user for EXPR if not passed as an argument.

     

       720
       720
       +
       With prefix arg (C-u), also prompts for date range with an interactive calendar.

     

       721
       721
       +
       Use this to find events matching specific text across all calendars.

     

       722
       722
       +
       TO-DATE is required; a default will be used if not provided."

     

       723
       723
       +
         (interactive

     

       724
       724
       +
          (let* ((search-text (read-string "Search for: " nil 'caledonia-search-prompt-history))

     

       725
       725
       +
                 (dates (when current-prefix-arg (caledonia--read-date-range))))

     

       726
       726
       +
            (list search-text

     

       727
       727
       +
                  (when current-prefix-arg (car dates))

     

       728
       728
       +
                  (when current-prefix-arg (cdr dates)))))

     

       729
       729
       +
         (let ((buffer (get-buffer-create caledonia--events-buffer))

     

       730
       730
       +
               (from (or from-date caledonia-search-from-date))

     

       731
       731
       +
               (to (or to-date caledonia-search-to-date)))

     

       732
       732
       +
           (with-current-buffer buffer

     

       733
       733
       +
             ;; Clear the buffer and reset it

     

       734
       734
       +
             (let ((inhibit-read-only t))

     

       735
       735
       +
               (erase-buffer))

     

       736
       736
       +
             ;; Build the query

     

       737
       737
       +
             (let* ((query `((text ,expr)(to ,to))))

     

       738
       738
       +
               ;; Add from date only if specified

     

       739
       739
       +
               (when (and from (not (string-empty-p from)))

     

       740
       740
       +
                 (setq query (append query `((from ,from)))))

     

       741
       741
       +
               ;; Activate our mode and make the query

     

       742
       742
       +
               (caledonia-mode)

     

       743
       743
       +
               (caledonia--make-query query)

     

       744
       744
       +
               (switch-to-buffer buffer)))))

     

       745
       745
       +
       

     

       746
       746
       +
       ;; Modes

     

       747
       747
       +
       ;;;###autoload

     

       748
       748
       +
       

     

       749
       749
       +
       ;; Create a filter prefix map for query refinement

     

       750
       750
       +
       (defvar caledonia-filter-map

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       759
       759
       +
           map)

     

       760
       760
       +
         "Keymap for filter commands in Caledonia mode.")

     

       761
       761
       +
       

     

       762
       762
       +
       (defvar caledonia-mode-map

     

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

     

       764
       764
       +
           (set-keymap-parent map tabulated-list-mode-map)

     

       765
       765
       +
           (define-key map (kbd "RET") 'caledonia-show-event)

     

       766
       766
       +
           (define-key map (kbd "M-RET") 'caledonia-open-event-file)

     

       767
       767
       +
           (define-key map (kbd "l") 'caledonia-list)

     

       768
       768
       +
           (define-key map (kbd "s") 'caledonia-search)

     

       769
       769
       +
           (define-key map (kbd "r") 'caledonia-refresh)

     

       770
       770
       +
           (define-key map (kbd "q") 'quit-window)

     

       771
       771
       +
           ;; Individual filter command bindings

     

       772
       772
       +
           (define-key map (kbd "C-c d") 'caledonia-query-date-range)

     

       773
       773
       +
           (define-key map (kbd "C-c c") 'caledonia-query-calendars)

     

       774
       774
       +
           (define-key map (kbd "C-c t") 'caledonia-query-text)

     

       775
       775
       +
           (define-key map (kbd "C-c i") 'caledonia-query-id)

     

       776
       776
       +
           (define-key map (kbd "C-c r") 'caledonia-query-recurring)

     

       777
       777
       +
           (define-key map (kbd "C-c l") 'caledonia-query-limit)

     

       778
       778
       +
           (define-key map (kbd "C-c z") 'caledonia-query-timezone)

     

       779
       779
       +
           ;; Use f prefix for filter commands

     

       780
       780
       +
           (define-key map (kbd "C-c f") caledonia-filter-map)

     

       781
       781
       +
           map)

     

       782
       782
       +
         "Keymap for Caledonia mode.")

     

       783
       783
       +
       

     

       784
       784
       +
       (define-derived-mode caledonia-mode tabulated-list-mode "Caledonia"

     

       785
       785
       +
         "Major mode for displaying calendar entries in a tabular view.")

     

       786
       786
       +
       

     

       787
       787
       +
       ;; Define a prefix map specifically for Evil mode

     

       788
       788
       +
       (defvar caledonia-evil-filter-map

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       797
       797
       +
           map)

     

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

     

       799
       799
       +
       

     

       800
       800
       +
       (eval-after-load 'evil

     

       801
       801
       +
         '(progn

     

       802
       802
       +
            ;; Basic navigation and commands

     

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

     

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

     

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

     

       806
       806
       +
              "l" 'caledonia-list

     

       807
       807
       +
              "s" 'caledonia-search

     

       808
       808
       +
              "r" 'caledonia-refresh

     

       809
       809
       +
              "q" 'quit-window)

     

       810
       810
       +
            ;; Set up a proper Evil prefix key

     

       811
       811
       +
            (evil-define-key 'normal caledonia-mode-map "f" caledonia-evil-filter-map)))

     

       812
       812
       +
       

     

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

     

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

     

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

     

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

     

       817
       817
       +
           (evil-normalize-keymaps)))

     

       818
       818
       +
       

     

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

     

       820
       820
       +
       

     

       821
       821
       +
       (provide 'caledonia)

     

       822
       822
       +
       ;;; caledonia.el ends here

+48 -84

lib/calendar_dir.ml

···

       1
       1
        
       open Icalendar

     

       2
       2
        
       

     

       3
       3
       -
       module CalendarMap = Map.Make (struct

     

       4
       4
       -
         type t = string

     

       5
       5
       -
       

     

       6
       6
       -
         let compare a b = String.compare a b

     

       7
       7
       -
       end)

     

       8
       8
       -
       

     

       9
       9
       -
       type t = { path : string; mutable calendar_names : Event.t list CalendarMap.t }

     

       3
       3
       +
       type t = string

     

       10
       4
        
       

     

       11
       5
        
       let get_calendar_path ~fs calendar_dir calendar_name_name =

     

       12
       12
       -
         Eio.Path.(fs / calendar_dir.path / calendar_name_name)

     

       6
       6
       +
         Eio.Path.(fs / calendar_dir / calendar_name_name)

     

       13
       7
        
       

     

       14
       8
        
       let ensure_dir path =

     

       15
       9
        
         try

     
···

       22
       16
        
       

     

       23
       17
        
       let create ~fs path =

     

       24
       18
        
         match ensure_dir Eio.Path.(fs / path) with

     

       25
       25
       -
         | Ok () -> Ok { path; calendar_names = CalendarMap.empty }

     

       19
       19
       +
         | Ok () -> Ok path

     

       26
       20
        
         | Error e -> Error e

     

       27
       21
        
       

     

       28
       22
        
       let list_calendar_names ~fs calendar_dir =

     

       29
       23
        
         try

     

       30
       30
       -
           let dir = Eio.Path.(fs / calendar_dir.path) in

     

       24
       24
       +
           let dir = Eio.Path.(fs / calendar_dir) in

     

       31
       25
        
           let calendar_names =

     

       32
       26
        
             Eio.Path.read_dir dir

     

       33
       27
        
             |> List.filter_map (fun file ->

     

       34
       34
       -
                    if Eio.Path.is_directory Eio.Path.(dir / file) then Some file

     

       28
       28
       +
                    if

     

       29
       29
       +
                      String.length file > 0

     

       30
       30
       +
                      && file.[0] != '.'

     

       31
       31
       +
                      && Eio.Path.is_directory Eio.Path.(dir / file)

     

       32
       32
       +
                    then Some file

     

       35
       33
        
                    else None)

     

       36
       34
        
             |> List.sort (fun a b -> String.compare a b)

     

       37
       35
        
           in

     
···

       39
       37
        
         with Eio.Exn.Io _ as exn ->

     

       40
       38
        
           Error

     

       41
       39
        
             (`Msg

     

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

     

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

     

       43
       41
        
                   Eio.Exn.pp exn))

     

       44
       42
        
       

     

       45
       43
        
       let rec load_events_recursive calendar_name dir_path =

     
···

       71
       69
        
           []

     

       72
       70
        
       

     

       73
       71
        
       let get_calendar_events ~fs calendar_dir calendar_name =

     

       74
       74
       -
         match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with

     

       75
       75
       -
         | Some events -> Ok events

     

       76
       76
       -
         | None -> (

     

       77
       77
       -
             let calendar_name_path =

     

       78
       78
       -
               get_calendar_path ~fs calendar_dir calendar_name

     

       79
       79
       -
             in

     

       80
       80
       -
             if not (Eio.Path.is_directory calendar_name_path) then Error `Not_found

     

       81
       81
       -
             else

     

       82
       82
       -
               try

     

       83
       83
       -
                 let events = load_events_recursive calendar_name calendar_name_path in

     

       84
       84
       -
                 calendar_dir.calendar_names <-

     

       85
       85
       -
                   CalendarMap.add calendar_name events calendar_dir.calendar_names;

     

       86
       86
       -
                 Ok events

     

       87
       87
       -
               with e ->

     

       88
       88
       -
                 Error

     

       89
       89
       -
                   (`Msg

     

       90
       90
       -
                      (Printf.sprintf "Exception processing directory %s: %s"

     

       91
       91
       -
                         (snd calendar_name_path) (Printexc.to_string e))))

     

       72
       72
       +
         let calendar_name_path =

     

       73
       73
       +
           get_calendar_path ~fs calendar_dir calendar_name

     

       74
       74
       +
         in

     

       75
       75
       +
         if not (Eio.Path.is_directory calendar_name_path) then Error `Not_found

     

       76
       76
       +
         else

     

       77
       77
       +
           try

     

       78
       78
       +
             let events = load_events_recursive calendar_name calendar_name_path in

     

       79
       79
       +
             Ok events

     

       80
       80
       +
           with e ->

     

       81
       81
       +
             Error

     

       82
       82
       +
               (`Msg

     

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

     

       84
       84
       +
                     (snd calendar_name_path) (Printexc.to_string e)))

     

       92
       85
        
       

     

       93
       86
        
       let ( let* ) = Result.bind

     

       94
       87
        
       

     
···

       113
       106
        
                    (Printf.sprintf "Error getting calendar_names: %s"

     

       114
       107
        
                       (Printexc.to_string exn))))

     

       115
       108
        
       

     

       116
       116
       -
       let add_event ~fs calendar_dir event =

     

       109
       109
       +
       let add_event ~fs calendar_dir events event =

     

       117
       110
        
         let calendar_name = Event.get_calendar_name event in

     

       118
       111
        
         let file = Event.get_file event in

     

       119
       112
        
         let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in

     

       120
       113
        
         let* () = ensure_dir calendar_name_path in

     

       121
       114
        
         let calendar = Event.to_ical_calendar event in

     

       122
       115
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       123
       123
       -
         let* _ =

     

       124
       116
        
           try

     

       125
       117
        
             Eio.Path.save ~create:(`Or_truncate 0o644) file content;

     

       126
       126
       -
             Ok ()

     

       118
       118
       +
             Ok (event :: events)

     

       127
       119
        
           with Eio.Exn.Io _ as exn ->

     

       128
       120
        
             Error

     

       129
       121
        
               (`Msg

     

       130
       122
        
                  (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       131
       131
       -
         in

     

       132
       132
       -
         calendar_dir.calendar_names <-

     

       133
       133
       -
           CalendarMap.add calendar_name

     

       134
       134
       -
             (event

     

       135
       135
       -
             ::

     

       136
       136
       -
             (match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with

     

       137
       137
       -
             | Some lst -> lst

     

       138
       138
       -
             | None -> []))

     

       139
       139
       -
             calendar_dir.calendar_names;

     

       140
       140
       -
         Ok ()

     

       141
       123
        
       

     

       142
       142
       -
       let edit_event ~fs calendar_dir event =

     

       124
       124
       +
       let edit_event ~fs calendar_dir events event =

     

       143
       125
        
         let calendar_name = Event.get_calendar_name event in

     

       144
       126
        
         let event_id = Event.get_id event in

     

       145
       127
        
         let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in

     
···

       162
       144
        
           (existing_props, `Event ical_event :: filtered_components)

     

       163
       145
        
         in

     

       164
       146
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       165
       165
       -
         let* _ =

     

       166
       166
       -
           try

     

       167
       167
       -
             Eio.Path.save ~create:(`Or_truncate 0o644) file content;

     

       168
       168
       -
             Ok ()

     

       169
       169
       -
           with Eio.Exn.Io _ as exn ->

     

       170
       170
       -
             Error

     

       171
       171
       -
               (`Msg

     

       172
       172
       -
                  (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       173
       173
       -
         in

     

       174
       174
       -
         calendar_dir.calendar_names <-

     

       175
       175
       -
           CalendarMap.add calendar_name

     

       176
       176
       -
             (event

     

       177
       177
       -
             ::

     

       178
       178
       -
             (match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with

     

       179
       179
       -
             (* filter old version *)

     

       180
       180
       -
             | Some lst -> List.filter (fun e -> Event.get_id e = event_id) lst

     

       181
       181
       -
             | None -> []))

     

       182
       182
       -
             calendar_dir.calendar_names;

     

       183
       183
       -
         Ok ()

     

       147
       147
       +
         try

     

       148
       148
       +
           Eio.Path.save ~create:(`Or_truncate 0o644) file content;

     

       149
       149
       +
           (* Filter out the old event and add the updated one *)

     

       150
       150
       +
           let filtered_events = List.filter (fun e -> Event.get_id e <> event_id) events in

     

       151
       151
       +
           Ok (event :: filtered_events)

     

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

     

       153
       153
       +
           Error

     

       154
       154
       +
             (`Msg

     

       155
       155
       +
                (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       184
       156
        
       

     

       185
       185
       -
       let delete_event ~fs calendar_dir event =

     

       157
       157
       +
       let delete_event ~fs calendar_dir events event =

     

       186
       158
        
         let calendar_name = Event.get_calendar_name event in

     

       187
       159
        
         let event_id = Event.get_id event in

     

       188
       160
        
         let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in

     
···

       208
       180
        
           (existing_props, filtered_components)

     

       209
       181
        
         in

     

       210
       182
        
         let content = Icalendar.to_ics ~cr:true calendar in

     

       211
       211
       -
         let* _ =

     

       212
       212
       -
           try

     

       213
       213
       -
             (match !other_events with

     

       214
       214
       -
             | true -> Eio.Path.save ~create:(`Or_truncate 0o644) file content

     

       215
       215
       -
             | false -> Eio.Path.unlink file);

     

       216
       216
       -
             Ok ()

     

       217
       217
       -
           with Eio.Exn.Io _ as exn ->

     

       218
       218
       -
             Error

     

       219
       219
       -
               (`Msg

     

       220
       220
       -
                  (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       221
       221
       -
         in

     

       222
       222
       -
         calendar_dir.calendar_names <-

     

       223
       223
       -
           CalendarMap.add calendar_name

     

       224
       224
       -
             (match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with

     

       225
       225
       -
             (* filter old version *)

     

       226
       226
       -
             | Some lst -> List.filter (fun e -> Event.get_id e = event_id) lst

     

       227
       227
       -
             | None -> [])

     

       228
       228
       -
             calendar_dir.calendar_names;

     

       229
       229
       -
         Ok ()

     

       183
       183
       +
         try

     

       184
       184
       +
           (match !other_events with

     

       185
       185
       +
           | true -> Eio.Path.save ~create:(`Or_truncate 0o644) file content

     

       186
       186
       +
           | false -> Eio.Path.unlink file);

     

       187
       187
       +
           (* Filter out the deleted event from the events list *)

     

       188
       188
       +
           let filtered_events = List.filter (fun e -> Event.get_id e <> event_id) events in

     

       189
       189
       +
           Ok filtered_events

     

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

     

       191
       191
       +
           Error

     

       192
       192
       +
             (`Msg

     

       193
       193
       +
                (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))

     

       230
       194
        
       

     

       231
       231
       -
       let get_path t = t.path

     

       195
       195
       +
       let get_path t = t

+12 -3

lib/calendar_dir.mli

···

       32
       32
        
       val add_event :

     

       33
       33
        
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       34
       34
        
         t ->

     

       35
       35
       +
         Event.t list ->

     

       35
       36
        
         Event.t ->

     

       36
       36
       -
         (unit, [> `Msg of string ]) result

     

       37
       37
       +
         (Event.t list, [> `Msg of string ]) result

     

       38
       38
       +
       (** Add an event to the calendar directory. Takes the current events list and returns

     

       39
       39
       +
           an updated events list with the new event added. *)

     

       37
       40
        
       

     

       38
       41
        
       val edit_event :

     

       39
       42
        
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       40
       43
        
         t ->

     

       44
       44
       +
         Event.t list ->

     

       41
       45
        
         Event.t ->

     

       42
       42
       -
         (unit, [> `Msg of string ]) result

     

       46
       46
       +
         (Event.t list, [> `Msg of string ]) result

     

       47
       47
       +
       (** Edit an event in the calendar directory. Takes the current events list and returns

     

       48
       48
       +
           an updated events list with the event updated. *)

     

       43
       49
        
       

     

       44
       50
        
       val delete_event :

     

       45
       51
        
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       46
       52
        
         t ->

     

       53
       53
       +
         Event.t list ->

     

       47
       54
        
         Event.t ->

     

       48
       48
       -
         (unit, [> `Msg of string ]) result

     

       55
       55
       +
         (Event.t list, [> `Msg of string ]) result

     

       56
       56
       +
       (** Delete an event from the calendar directory. Takes the current events list and returns

     

       57
       57
       +
           an updated events list with the event removed. *)

     

       49
       58
        
       

     

       50
       59
        
       val get_path : t -> string

+44 -1

lib/date.ml

···

       165
       165
        
       let get_end_of_next_month ?(tz = !default_timezone ()) () =

     

       166
       166
        
         get_end_of_month (get_start_of_next_month ~tz ())

     

       167
       167
        
       

     

       168
       168
       +
       let get_start_of_year date =

     

       169
       169
       +
         let dt = ptime_to_timedesc date in

     

       170
       170
       +
         let year = Timedesc.year dt in

     

       171
       171
       +
       

     

       172
       172
       +
         (* Create a date for the first of January *)

     

       173
       173
       +
         match Timedesc.Date.Ymd.make ~year ~month:1 ~day:1 with

     

       174
       174
       +
         | Ok first_day ->

     

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

     

       176
       176
       +
             let first_of_year = Timedesc.of_date_and_time_exn first_day midnight in

     

       177
       177
       +
             timedesc_to_ptime first_of_year

     

       178
       178
       +
         | Error _ -> failwith "Invalid date for start of year"

     

       179
       179
       +
       

     

       180
       180
       +
       let get_start_of_current_year ?(tz = !default_timezone ()) () =

     

       181
       181
       +
         get_start_of_year (!get_today ~tz ())

     

       182
       182
       +
       

     

       183
       183
       +
       let get_start_of_next_year ?(tz = !default_timezone ()) () =

     

       184
       184
       +
         add_years (get_start_of_current_year ~tz ()) 1

     

       185
       185
       +
       

     

       186
       186
       +
       let get_end_of_year date =

     

       187
       187
       +
         let dt = ptime_to_timedesc date in

     

       188
       188
       +
         let year = Timedesc.year dt in

     

       189
       189
       +
       

     

       190
       190
       +
         (* Create a date for the last day of the year (December 31) *)

     

       191
       191
       +
         match Timedesc.Date.Ymd.make ~year ~month:12 ~day:31 with

     

       192
       192
       +
         | Ok last_day ->

     

       193
       193
       +
             let end_of_day =

     

       194
       194
       +
               Timedesc.Time.make_exn ~hour:23 ~minute:59 ~second:59 ()

     

       195
       195
       +
             in

     

       196
       196
       +
             let end_of_year = Timedesc.of_date_and_time_exn last_day end_of_day in

     

       197
       197
       +
             timedesc_to_ptime end_of_year

     

       198
       198
       +
         | Error _ -> failwith "Invalid date for end of year"

     

       199
       199
       +
       

     

       200
       200
       +
       let get_end_of_current_year ?(tz = !default_timezone ()) () =

     

       201
       201
       +
         get_end_of_year (!get_today ~tz ())

     

       202
       202
       +
       

     

       203
       203
       +
       let get_end_of_next_year ?(tz = !default_timezone ()) () =

     

       204
       204
       +
         get_end_of_year (get_start_of_next_year ~tz ())

     

       205
       205
       +
       

     

       168
       206
        
       let convert_relative_date_formats ?(tz = !default_timezone ()) ~today ~tomorrow

     

       169
       207
        
           ~week ~month () =

     

       170
       208
        
         if today then

     
···

       269
       307
        
         else None

     

       270
       308
        
       

     

       271
       309
        
       let parse_relative ~tz expr parameter =

     

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

     

       310
       310
       +
         let regex = Re.Pcre.regexp "^([+-])(\\d+)([dwmy])$" in

     

       273
       311
        
         if Re.Pcre.pmatch ~rex:regex expr then

     

       274
       312
        
           let match_result = Re.Pcre.exec ~rex:regex expr in

     

       275
       313
        
           let sign = Re.Pcre.get_substring match_result 1 in

     
···

       290
       328
        
               match parameter with

     

       291
       329
        
               | `From -> Some (Ok (get_start_of_month date))

     

       292
       330
        
               | `To -> Some (Ok (get_end_of_month date)))

     

       331
       331
       +
           | "y" -> (

     

       332
       332
       +
               let date = add_years today value in

     

       333
       333
       +
               match parameter with

     

       334
       334
       +
               | `From -> Some (Ok (get_start_of_year date))

     

       335
       335
       +
               | `To -> Some (Ok (get_end_of_year date)))

     

       293
       336
        
           | _ -> Some (Error (`Msg (Printf.sprintf "Invalid date unit: %s" unit)))

     

       294
       337
        
         else None

     

       295
       338

+30 -1

lib/date.mli

···

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

     

       95
       95
        
           cannot be calculated. *)

     

       96
       96
        
       

     

       97
       97
       +
       val get_start_of_year : Ptime.t -> Ptime.t

     

       98
       98
       +
       (** Get the start of the year (Jan 1) for the given date. Raises an exception if

     

       99
       99
       +
           the date cannot be calculated. *)

     

       100
       100
       +
       

     

       101
       101
       +
       val get_start_of_current_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       102
       102
       +
       (** Get the start of the current year in the specified timezone. If no timezone

     

       103
       103
       +
           is provided, uses the default_timezone. Raises an exception if the date

     

       104
       104
       +
           cannot be calculated. *)

     

       105
       105
       +
       

     

       106
       106
       +
       val get_start_of_next_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       107
       107
       +
       (** Get the start of next year in the specified timezone. If no timezone is

     

       108
       108
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       109
       109
       +
           be calculated. *)

     

       110
       110
       +
       

     

       111
       111
       +
       val get_end_of_year : Ptime.t -> Ptime.t

     

       112
       112
       +
       (** Get the end of the year (Dec 31, 23:59:59) for the given date. Raises an

     

       113
       113
       +
           exception if the date cannot be calculated. *)

     

       114
       114
       +
       

     

       115
       115
       +
       val get_end_of_current_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       116
       116
       +
       (** Get the end of the current year in the specified timezone. If no timezone is

     

       117
       117
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       118
       118
       +
           be calculated. *)

     

       119
       119
       +
       

     

       120
       120
       +
       val get_end_of_next_year : ?tz:Timedesc.Time_zone.t -> unit -> Ptime.t

     

       121
       121
       +
       (** Get the end of next year in the specified timezone. If no timezone is

     

       122
       122
       +
           provided, uses the default_timezone. Raises an exception if the date cannot

     

       123
       123
       +
           be calculated. *)

     

       124
       124
       +
       

     

       97
       125
        
       val convert_relative_date_formats :

     

       98
       126
        
         ?tz:Timedesc.Time_zone.t ->

     

       99
       127
        
         today:bool ->

     
···

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

     

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

     

       138
       166
        
           - "+Nw" - N weeks from today

     

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

     

       167
       167
       +
           - "+Nm" - N months from today

     

       168
       168
       +
           - "+Ny" - N years from today *)

     

       140
       169
        
       

     

       141
       170
        
       val parse_time : string -> (int * int * int, [> `Msg of string ]) result

     

       142
       171
        
       (** Parse a time string in HH:MM or HH:MM:SS format. Returns Ok with (hour,

+4 -2

lib/dune

···

       13
       13
        
         yojson

     

       14
       14
        
         uuidm

     

       15
       15
        
         eio

     

       16
       16
       -
         eio_main)

     

       16
       16
       +
         eio_main

     

       17
       17
       +
         cmdliner

     

       18
       18
       +
         sexplib)

     

       17
       19
        
        (preprocess

     

       18
       18
       -
         (pps ppx_deriving.show ppx_deriving.eq)))

     

       20
       20
       +
         (pps ppx_deriving.show ppx_deriving.eq ppx_sexp_conv)))

+105 -28

lib/event.ml

···

       577
       577
        
             let summary =

     

       578
       578
        
               match get_summary event with Some summary -> summary | None -> ""

     

       579
       579
        
             in

     

       580
       580
       -
             let start_date, start_time =

     

       580
       580
       +
             let start_str =

     

       581
       581
        
               let dt = Date.ptime_to_timedesc ?tz start in

     

       582
       582
        
               let y = Timedesc.year dt in

     

       583
       583
        
               let m = Timedesc.month dt in

     
···

       585
       585
        
               let h = Timedesc.hour dt in

     

       586
       586
        
               let min = Timedesc.minute dt in

     

       587
       587
        
               let s = Timedesc.second dt in

     

       588
       588
       -
               let dow =

     

       589
       589
       -
                 match Timedesc.weekday dt with

     

       590
       590
       -
                 | `Mon -> "monday"

     

       591
       591
       -
                 | `Tue -> "tuesday"

     

       592
       592
       -
                 | `Wed -> "wednesday"

     

       593
       593
       -
                 | `Thu -> "thursday"

     

       594
       594
       -
                 | `Fri -> "friday"

     

       595
       595
       -
                 | `Sat -> "saturday"

     

       596
       596
       -
                 | `Sun -> "sunday"

     

       597
       597
       -
               in

     

       598
       598
       -
               ( Printf.sprintf "(%04d %02d %02d %s)" y m d dow,

     

       599
       599
       -
                 Printf.sprintf "(%02d %02d %02d)" h min s )

     

       588
       588
       +
               (* Format as a single timestamp string that's easy for Emacs to parse *)

     

       589
       589
       +
               Printf.sprintf "\"%04d-%02d-%02dT%02d:%02d:%02d\"" y m d h min s

     

       600
       590
        
             in

     

       601
       591
        
             let end_str =

     

       602
       592
        
               match end_ with

     
···

       608
       598
        
                   let h = Timedesc.hour dt in

     

       609
       599
        
                   let min = Timedesc.minute dt in

     

       610
       600
        
                   let s = Timedesc.second dt in

     

       611
       611
       -
                   let dow =

     

       612
       612
       -
                     match Timedesc.weekday dt with

     

       613
       613
       -
                     | `Mon -> "monday"

     

       614
       614
       -
                     | `Tue -> "tuesday"

     

       615
       615
       -
                     | `Wed -> "wednesday"

     

       616
       616
       -
                     | `Thu -> "thursday"

     

       617
       617
       -
                     | `Fri -> "friday"

     

       618
       618
       -
                     | `Sat -> "saturday"

     

       619
       619
       -
                     | `Sun -> "sunday"

     

       620
       620
       -
                   in

     

       621
       621
       -
                   Printf.sprintf "((%04d %02d %02d %s) (%02d %02d %02d))" y m d dow h

     

       622
       622
       -
                     min s

     

       601
       601
       +
                   Printf.sprintf "\"%04d-%02d-%02dT%02d:%02d:%02d\"" y m d h min s

     

       623
       602
        
               | None -> "nil"

     

       624
       603
        
             in

     

       625
       604
        
             let location =

     
···

       638
       617
        
             in

     

       639
       618
        
             let id = get_id event in

     

       640
       619
        
             Printf.sprintf

     

       641
       641
       -
               "((:id \"%s\" :summary \"%s\" :start (%s %s) :end %s :location %s \

     

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

     

       642
       621
        
                :description %s :calendar %s))"

     

       643
       643
       -
               (String.escaped id) (String.escaped summary) start_date start_time

     

       644
       644
       -
               end_str location description calendar

     

       622
       622
       +
               (String.escaped id) (String.escaped summary) start_str end_str location

     

       623
       623
       +
               description calendar

     

       645
       624
        
       

     

       646
       625
        
       let format_events_with_dynamic_columns ?tz events =

     

       647
       626
        
         if events = [] then ""

     
···

       762
       741
        
               recur_events ~recurrence_ids:other_events ical_event

     

       763
       742
        
             in

     

       764
       743
        
             collect generator []

     

       744
       744
       +
       

     

       745
       745
       +
       let sexp_of_t event =

     

       746
       746
       +
         let open Sexplib.Sexp in

     

       747
       747
       +
         let start = get_start event in

     

       748
       748
       +
         let end_ = get_end event in

     

       749
       749
       +
         let format_ptime_iso p =

     

       750
       750
       +
           let dt = Date.ptime_to_timedesc p in

     

       751
       751
       +
           let y = Timedesc.year dt in

     

       752
       752
       +
           let m = Timedesc.month dt in

     

       753
       753
       +
           let d = Timedesc.day dt in

     

       754
       754
       +
           let h = Timedesc.hour dt in

     

       755
       755
       +
           let min = Timedesc.minute dt in

     

       756
       756
       +
           let s = Timedesc.second dt in

     

       757
       757
       +
           Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02d" y m d h min s

     

       758
       758
       +
         in

     

       759
       759
       +
         let entries =

     

       760
       760
       +
           [

     

       761
       761
       +
             Some (List [ Atom "id"; Atom (get_id event) ]);

     

       762
       762
       +
             (match get_summary event with

     

       763
       763
       +
             | Some s -> Some (List [ Atom "summary"; Atom s ])

     

       764
       764
       +
             | None -> None);

     

       765
       765
       +
             Some (List [ Atom "start"; Atom (format_ptime_iso start) ]);

     

       766
       766
       +
             (match end_ with

     

       767
       767
       +
             | Some e -> Some (List [ Atom "end"; Atom (format_ptime_iso e) ])

     

       768
       768
       +
             | None -> None);

     

       769
       769
       +
             (match get_location event with

     

       770
       770
       +
             | Some l -> Some (List [ Atom "location"; Atom l ])

     

       771
       771
       +
             | None -> None);

     

       772
       772
       +
             (match get_description event with

     

       773
       773
       +
             | Some d -> Some (List [ Atom "description"; Atom d ])

     

       774
       774
       +
             | None -> None);

     

       775
       775
       +
             Some (List [ Atom "file"; Atom (snd (get_file event)) ]);

     

       776
       776
       +
             Some (List [ Atom "calendar"; Atom (get_calendar_name event) ]);

     

       777
       777
       +
           ]

     

       778
       778
       +
         in

     

       779
       779
       +
         let filtered_entries = List.filter_map Fun.id entries in

     

       780
       780
       +
         List filtered_entries

     

       781
       781
       +
       

     

       782
       782
       +
       type filter = t -> bool

     

       783
       783
       +
       

     

       784
       784
       +
       let text_matches pattern text =

     

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

     

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

     

       787
       787
       +
       

     

       788
       788
       +
       let summary_contains text event =

     

       789
       789
       +
         match get_summary event with

     

       790
       790
       +
         | Some summary -> text_matches text summary

     

       791
       791
       +
         | None -> false

     

       792
       792
       +
       

     

       793
       793
       +
       let description_contains text event =

     

       794
       794
       +
         match get_description event with

     

       795
       795
       +
         | Some desc -> text_matches text desc

     

       796
       796
       +
         | None -> false

     

       797
       797
       +
       

     

       798
       798
       +
       let location_contains text event =

     

       799
       799
       +
         match get_location event with

     

       800
       800
       +
         | Some loc -> text_matches text loc

     

       801
       801
       +
         | None -> false

     

       802
       802
       +
       

     

       803
       803
       +
       let in_calendars ids event =

     

       804
       804
       +
         let id = get_calendar_name event in

     

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

     

       806
       806
       +
       

     

       807
       807
       +
       let recurring_only () event = get_recurrence event <> None

     

       808
       808
       +
       let non_recurring_only () event = get_recurrence event = None

     

       809
       809
       +
       let with_id id event = get_id event = id

     

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

     

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

     

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

     

       813
       813
       +
       let matches_filter event filter = filter event

     

       814
       814
       +
       

     

       815
       815
       +
       let take n list =

     

       816
       816
       +
         let rec aux n lst acc =

     

       817
       817
       +
           match (lst, n) with

     

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

     

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

     

       820
       820
       +
           | x :: xs, n -> aux (n - 1) xs (x :: acc)

     

       821
       821
       +
         in

     

       822
       822
       +
         aux n list []

     

       823
       823
       +
       

     

       824
       824
       +
       let query_without_recurrence events ?filter ?(comparator = by_start) ?limit () =

     

       825
       825
       +
         let events =

     

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

     

       827
       827
       +
         in

     

       828
       828
       +
         let events = List.sort comparator events in

     

       829
       829
       +
         match limit with Some n when n > 0 -> take n events | _ -> events

     

       830
       830
       +
       

     

       831
       831
       +
       let query events ?filter ~from ~to_ ?comparator ?limit () =

     

       832
       832
       +
         let events =

     

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

     

       834
       834
       +
         in

     

       835
       835
       +
         let events =

     

       836
       836
       +
           List.concat_map (fun event -> expand_recurrences event ~from ~to_) events

     

       837
       837
       +
         in

     

       838
       838
       +
         let events =

     

       839
       839
       +
           match comparator with None -> events | Some c -> List.sort c events

     

       840
       840
       +
         in

     

       841
       841
       +
         match limit with Some n when n > 0 -> take n events | _ -> events

+45

lib/event.mli

···

       117
       117
        
       val format_events :

     

       118
       118
        
         ?format:format -> ?tz:Timedesc.Time_zone.t -> t list -> string

     

       119
       119
        
       (** Format a list of events, optionally using the specified timezone *)

     

       120
       120
       +
       

     

       121
       121
       +
       val sexp_of_t : t -> Sexplib0.Sexp.t

     

       122
       122
       +
       

     

       123
       123
       +
       (** 3 Queries *)

     

       124
       124
       +
       

     

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

     

       126
       126
       +
       

     

       127
       127
       +
       type filter = t -> bool

     

       128
       128
       +
       

     

       129
       129
       +
       val summary_contains : string -> filter

     

       130
       130
       +
       val description_contains : string -> filter

     

       131
       131
       +
       val location_contains : string -> filter

     

       132
       132
       +
       val in_calendars : string list -> filter

     

       133
       133
       +
       val recurring_only : unit -> filter

     

       134
       134
       +
       val non_recurring_only : unit -> filter

     

       135
       135
       +
       val with_id : event_id -> filter

     

       136
       136
       +
       val and_filter : filter list -> filter

     

       137
       137
       +
       val or_filter : filter list -> filter

     

       138
       138
       +
       val not_filter : filter -> filter

     

       139
       139
       +
       

     

       140
       140
       +
       val query_without_recurrence :

     

       141
       141
       +
         t list ->

     

       142
       142
       +
         ?filter:filter ->

     

       143
       143
       +
         ?comparator:comparator ->

     

       144
       144
       +
         ?limit:int ->

     

       145
       145
       +
         unit ->

     

       146
       146
       +
         t list

     

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

     

       148
       148
       +
           of events, or Error with a message. *)

     

       149
       149
       +
       

     

       150
       150
       +
       val query :

     

       151
       151
       +
         t list ->

     

       152
       152
       +
         ?filter:filter ->

     

       153
       153
       +
         from:Ptime.t option ->

     

       154
       154
       +
         to_:Ptime.t ->

     

       155
       155
       +
         ?comparator:comparator ->

     

       156
       156
       +
         ?limit:int ->

     

       157
       157
       +
         unit ->

     

       158
       158
       +
         t list

     

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

     

       160
       160
       +
           events, or Error with a message. *)

     

       161
       161
       +
       

     

       162
       162
       +
       (* Test-only helper functions *)

     

       163
       163
       +
       val matches_filter : t -> filter -> bool

     

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

-66

lib/query.ml

···

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

     

       2
       2
       -
       

     

       3
       3
       -
       let text_matches pattern text =

     

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

     

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

     

       6
       6
       -
       

     

       7
       7
       -
       let summary_contains text event =

     

       8
       8
       -
         match Event.get_summary event with

     

       9
       9
       -
         | Some summary -> text_matches text summary

     

       10
       10
       -
         | None -> false

     

       11
       11
       -
       

     

       12
       12
       -
       let description_contains text event =

     

       13
       13
       -
         match Event.get_description event with

     

       14
       14
       -
         | Some desc -> text_matches text desc

     

       15
       15
       -
         | None -> false

     

       16
       16
       -
       

     

       17
       17
       -
       let location_contains text event =

     

       18
       18
       -
         match Event.get_location event with

     

       19
       19
       -
         | Some loc -> text_matches text loc

     

       20
       20
       -
         | None -> false

     

       21
       21
       -
       

     

       22
       22
       -
       let in_calendars ids event =

     

       23
       23
       -
         let id = Event.get_calendar_name event in

     

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

     

       25
       25
       -
       

     

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

     

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

     

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

     

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

     

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

     

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

     

       32
       32
       -
       let matches_filter event filter = filter event

     

       33
       33
       -
       

     

       34
       34
       -
       let take n list =

     

       35
       35
       -
         let rec aux n lst acc =

     

       36
       36
       -
           match (lst, n) with

     

       37
       37
       -
           | _, 0 -> List.rev acc

     

       38
       38
       -
           | [], _ -> List.rev acc

     

       39
       39
       -
           | x :: xs, n -> aux (n - 1) xs (x :: acc)

     

       40
       40
       -
         in

     

       41
       41
       -
         aux n list []

     

       42
       42
       -
       

     

       43
       43
       -
       let ( let* ) = Result.bind

     

       44
       44
       -
       

     

       45
       45
       -
       let query_without_recurrence ~fs calendar_dir ?filter

     

       46
       46
       -
           ?(comparator = Event.by_start) ?limit () =

     

       47
       47
       -
         let* events = Calendar_dir.get_events ~fs calendar_dir in

     

       48
       48
       -
         let events =

     

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

     

       50
       50
       -
         in

     

       51
       51
       -
         let events = List.sort comparator events in

     

       52
       52
       -
         Ok (match limit with Some n when n > 0 -> take n events | _ -> events)

     

       53
       53
       -
       

     

       54
       54
       -
       let query ~fs calendar_dir ?filter ~from ~to_ ?(comparator = Event.by_start)

     

       55
       55
       -
           ?limit () =

     

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

     

       57
       57
       -
         let events =

     

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

     

       59
       59
       -
         in

     

       60
       60
       -
         let events =

     

       61
       61
       -
           List.concat_map

     

       62
       62
       -
             (fun event -> Event.expand_recurrences event ~from ~to_)

     

       63
       63
       -
             events

     

       64
       64
       -
         in

     

       65
       65
       -
         let events = List.sort comparator events in

     

       66
       66
       -
         Ok (match limit with Some n when n > 0 -> take n events | _ -> events)

-42

lib/query.mli

···

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

     

       2
       2
       -
       

     

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

     

       4
       4
       -
       

     

       5
       5
       -
       val summary_contains : string -> filter

     

       6
       6
       -
       val description_contains : string -> filter

     

       7
       7
       -
       val location_contains : string -> filter

     

       8
       8
       -
       val in_calendars : string list -> filter

     

       9
       9
       -
       val recurring_only : unit -> filter

     

       10
       10
       -
       val non_recurring_only : unit -> filter

     

       11
       11
       -
       val with_id : Event.event_id -> filter

     

       12
       12
       -
       val and_filter : filter list -> filter

     

       13
       13
       -
       val or_filter : filter list -> filter

     

       14
       14
       -
       val not_filter : filter -> filter

     

       15
       15
       -
       

     

       16
       16
       -
       val query_without_recurrence :

     

       17
       17
       -
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       18
       18
       -
         Calendar_dir.t ->

     

       19
       19
       -
         ?filter:filter ->

     

       20
       20
       -
         ?comparator:Event.comparator ->

     

       21
       21
       -
         ?limit:int ->

     

       22
       22
       -
         unit ->

     

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

     

       24
       24
       -
       (** Find events without expansion of recurring events. Returns Ok with the list

     

       25
       25
       -
           of events, or Error with a message. *)

     

       26
       26
       -
       

     

       27
       27
       -
       val query :

     

       28
       28
       -
         fs:Eio.Fs.dir_ty Eio.Path.t ->

     

       29
       29
       -
         Calendar_dir.t ->

     

       30
       30
       -
         ?filter:filter ->

     

       31
       31
       -
         from:Ptime.t option ->

     

       32
       32
       -
         to_:Ptime.t ->

     

       33
       33
       -
         ?comparator:Event.comparator ->

     

       34
       34
       -
         ?limit:int ->

     

       35
       35
       -
         unit ->

     

       36
       36
       -
         (Event.t list, [> `Msg of string ]) result

     

       37
       37
       -
       (** Find events with expansion of recurring events. Returns Ok with the list of

     

       38
       38
       -
           events, or Error with a message. *)

     

       39
       39
       -
       

     

       40
       40
       -
       (* Test-only helper functions *)

     

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

     

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

+120

lib/sexp.ml

···

       1
       1
       +
       open Sexplib.Std

     

       2
       2
       +
       

     

       3
       3
       +
       type search_field = Summary | Description | Location [@@deriving sexp]

     

       4
       4
       +
       

     

       5
       5
       +
       type query_request = {

     

       6
       6
       +
         from : string option; [@sexp.option]

     

       7
       7
       +
         to_ : string; (* Required field, not optional *)

     

       8
       8
       +
         timezone : string option; [@sexp.option]

     

       9
       9
       +
         calendars : string list; [@default []]

     

       10
       10
       +
         text : string option; [@sexp.option]

     

       11
       11
       +
         search_in : search_field list; [@default []]

     

       12
       12
       +
         id : string option; [@sexp.option]

     

       13
       13
       +
         recurring : bool option; [@sexp.option]

     

       14
       14
       +
         limit : int option; [@sexp.option]

     

       15
       15
       +
       }

     

       16
       16
       +
       [@@deriving sexp]

     

       17
       17
       +
       

     

       18
       18
       +
       (* workaround https://github.com/janestreet/ppx_sexp_conv/issues/18#issuecomment-2792574295 *)

     

       19
       19
       +
       let query_request_of_sexp sexp =

     

       20
       20
       +
         let open Sexplib.Sexp in

     

       21
       21
       +
         let sexp = match sexp with

     

       22
       22
       +
           | List ss ->

     

       23
       23
       +
             List (List.map (function List (Atom "to" :: v) -> List (Atom "to_" :: v) | v -> v) ss)

     

       24
       24
       +
           | v -> v

     

       25
       25
       +
         in

     

       26
       26
       +
         query_request_of_sexp sexp

     

       27
       27
       +
       

     

       28
       28
       +
       let sexp_of_query_request q =

     

       29
       29
       +
         let open Sexplib.Sexp in

     

       30
       30
       +
         let sexp = sexp_of_query_request q in

     

       31
       31
       +
         let sexp = match sexp with

     

       32
       32
       +
           | List ss ->

     

       33
       33
       +
             List (List.map (function List (Atom "to_" :: v) -> List (Atom "to" :: v) | v -> v) ss)

     

       34
       34
       +
           | v -> v

     

       35
       35
       +
         in

     

       36
       36
       +
         sexp

     

       37
       37
       +
       

     

       38
       38
       +
       type request = ListCalendars | Query of query_request | Refresh [@@deriving sexp]

     

       39
       39
       +
       

     

       40
       40
       +
       type response_payload = Calendars of string list | Events of Event.t list | Empty

     

       41
       41
       +
       [@@deriving sexp_of]

     

       42
       42
       +
       

     

       43
       43
       +
       type response = Ok of response_payload | Error of string [@@deriving sexp_of]

     

       44
       44
       +
       

     

       45
       45
       +
       let filter_func_of_search_field text = function

     

       46
       46
       +
         | Summary -> Event.summary_contains text

     

       47
       47
       +
         | Description -> Event.description_contains text

     

       48
       48
       +
         | Location -> Event.location_contains text

     

       49
       49
       +
       

     

       50
       50
       +
       let parse_timezone ~timezone =

     

       51
       51
       +
         match timezone with

     

       52
       52
       +
         | Some tzid -> (

     

       53
       53
       +
             match Timedesc.Time_zone.make tzid with

     

       54
       54
       +
             | Some tz -> tz

     

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

     

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

     

       57
       57
       +
       

     

       58
       58
       +
       let generate_query_params (req : query_request) =

     

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

     

       60
       60
       +
         let tz = parse_timezone ~timezone:req.timezone in

     

       61
       61
       +
         let* from =

     

       62
       62
       +
           match req.from with

     

       63
       63
       +
           | None -> Ok None

     

       64
       64
       +
           | Some s -> Result.map Option.some (Date.parse_date ~tz s `From)

     

       65
       65
       +
         in

     

       66
       66
       +
         let* to_ =

     

       67
       67
       +
           let* to_date = Date.parse_date ~tz req.to_ `To in

     

       68
       68
       +
           Ok (Date.to_end_of_day to_date)

     

       69
       69
       +
         in

     

       70
       70
       +
         let filters = ref [] in

     

       71
       71
       +
         (match req.calendars with

     

       72
       72
       +
         | [] -> ()

     

       73
       73
       +
         | cals -> filters := Event.in_calendars cals :: !filters);

     

       74
       74
       +
         (match req.text with

     

       75
       75
       +
         | Some text ->

     

       76
       76
       +
             let search_fields =

     

       77
       77
       +
               match req.search_in with

     

       78
       78
       +
               | [] -> [ Summary; Description; Location ]

     

       79
       79
       +
               | fields -> fields

     

       80
       80
       +
             in

     

       81
       81
       +
             let text_filters =

     

       82
       82
       +
               List.map (filter_func_of_search_field text) search_fields

     

       83
       83
       +
             in

     

       84
       84
       +
             filters := Event.or_filter text_filters :: !filters

     

       85
       85
       +
         | None -> ());

     

       86
       86
       +
         (match req.id with

     

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

     

       88
       88
       +
         | None -> ());

     

       89
       89
       +
         (match req.recurring with

     

       90
       90
       +
         | Some true -> filters := Event.recurring_only () :: !filters

     

       91
       91
       +
         | Some false -> filters := Event.non_recurring_only () :: !filters

     

       92
       92
       +
         | _ -> ());

     

       93
       93
       +
         let final_filter = Event.and_filter !filters in

     

       94
       94
       +
         let limit = req.limit in

     

       95
       95
       +
         Ok (final_filter, from, to_, limit, tz)

     

       96
       96
       +
       

     

       97
       97
       +
       let is_whitespace = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false

     

       98
       98
       +
       

     

       99
       99
       +
       let needs_quotes s =

     

       100
       100
       +
         String.exists

     

       101
       101
       +
           (fun c -> is_whitespace c || c = '(' || c = ')' || c = '"' || c = '\'')

     

       102
       102
       +
           s

     

       103
       103
       +
       

     

       104
       104
       +
       let escape s =

     

       105
       105
       +
         let buf = Buffer.create (String.length s) in

     

       106
       106
       +
         String.iter

     

       107
       107
       +
           (function

     

       108
       108
       +
             | '"' -> Buffer.add_string buf "\\\""

     

       109
       109
       +
             | '\\' -> Buffer.add_string buf "\\\\"

     

       110
       110
       +
             | '\n' -> Buffer.add_string buf "\\n"

     

       111
       111
       +
             | '\r' -> Buffer.add_string buf "\\r"

     

       112
       112
       +
             | '\t' -> Buffer.add_string buf "\\t"

     

       113
       113
       +
             | c -> Buffer.add_char buf c)

     

       114
       114
       +
           s;

     

       115
       115
       +
         "\"" ^ Buffer.contents buf ^ "\""

     

       116
       116
       +
       

     

       117
       117
       +
       let rec to_string = function

     

       118
       118
       +
         | Sexplib.Sexp.Atom str -> if needs_quotes str then escape str else str

     

       119
       119
       +
         | Sexplib.Sexp.List lst ->

     

       120
       120
       +
             "(" ^ String.concat " " (List.map to_string lst) ^ ")"

+1 -1

test/dune

···

       1
       1
        
       (tests

     

       2
       2
       -
        (names test_calendar_dir test_query)

     

       2
       2
       +
        (names test_calendar_dir test_date test_event)

     

       3
       3
        
        (libraries caledonia_lib alcotest str ptime)

     

       4
       4
        
        (deps

     

       5
       5
        
         (source_tree calendar)))

+7 -7

test/test_date.ml

···

       1
       1
        
       (* Test the Date module *)

     

       2
       2
        
       

     

       3
       3
       +
       open Caledonia_lib

     

       4
       4
       +
       

     

       3
       5
        
       (* Setup a fixed date for testing *)

     

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

     

       5
       7
        
       

     

       6
       8
        
       let setup_fixed_date () =

     

       7
       7
       -
         (Date.get_today := fun () -> fixed_date);

     

       9
       9
       +
         (Date.get_today := fun ?tz:_ () -> fixed_date);

     

       8
       10
        
         fixed_date

     

       9
       11
        
       

     

       10
       12
        
       let test_parse_date () =

     

       11
       13
        
         let test_expr expr parameter expected =

     

       12
       14
        
           try

     

       13
       13
       -
             let result = Query.parse_date expr parameter in

     

       15
       15
       +
             let result = Result.get_ok @@ Date.parse_date expr parameter in

     

       14
       16
        
             let result_str =

     

       15
       17
        
               let y, m, d = Ptime.to_date result in

     

       16
       18
        
               Printf.sprintf "%04d-%02d-%02d" y m d

     
···

       54
       56
        
         test_expr "2025-3-1" `From "2025-03-01";

     

       55
       57
        
         test_expr "2025-3-1" `To "2025-03-01";

     

       56
       58
        
         (try

     

       57
       57
       -
            let _ = Query.parse_date "invalid-format" `From in

     

       59
       59
       +
            let _ = Result.get_ok @@ Date.parse_date "invalid-format" `From in

     

       58
       60
        
            Alcotest.fail "Should have raised an exception for invalid format"

     

       59
       61
        
          with Failure msg ->

     

       60
       62
        
            Alcotest.(check bool)

     
···

       62
       64
        
              (String.length msg > 0));

     

       63
       65
        
         ()

     

       64
       66
        
       

     

       65
       65
       -
       let date_tests fs = [ ("date expression parsing", `Quick, test_parse_date) ]

     

       67
       67
       +
       let date_tests = [ ("date expression parsing", `Quick, test_parse_date) ]

     

       66
       68
        
       

     

       67
       69
        
       let () =

     

       68
       68
       -
         Eio_main.run @@ fun env ->

     

       69
       69
       -
         let fs = Eio.Stdenv.fs env in

     

       70
       70
        
         let _ = setup_fixed_date () in

     

       71
       71
       -
         Alcotest.run "Query Tests" [ ("query", date_tests fs) ]

     

       71
       71
       +
         Alcotest.run "Query Tests" [ ("query", date_tests) ]

+92 -109

test/test_query.ml test/test_event.ml

···

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

     

       20
       20
        
         in

     

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

     

       22
       22
       -
         match Query.query ~fs calendar_dir ~from ~to_ () with

     

       23
       23
       -
         | Ok events ->

     

       24
       24
       -
             Alcotest.(check int) "Should find events" 791 (List.length events);

     

       25
       25
       -
             let test_event =

     

       26
       26
       -
               List.find_opt

     

       27
       27
       -
                 (fun event -> Option.get @@ Event.get_summary event = "Test Event")

     

       28
       28
       -
                 events

     

       29
       29
       -
             in

     

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

     

       31
       31
       -
         | Error _ -> Alcotest.fail "Error querying events"

     

       22
       22
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       23
       23
       +
         let events = Event.query events ~from ~to_ () in

     

       24
       24
       +
         Alcotest.(check int) "Should find events" 791 (List.length events);

     

       25
       25
       +
         let test_event =

     

       26
       26
       +
           List.find_opt

     

       27
       27
       +
             (fun event -> Option.get @@ Event.get_summary event = "Test Event")

     

       28
       28
       +
             events

     

       29
       29
       +
         in

     

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

     

       32
       31
        
       

     

       33
       32
        
       let test_recurrence_expansion ~fs () =

     

       34
       33
        
         let calendar_dir =

     
···

       40
       39
        
         let to_ =

     

       41
       40
        
           Option.get @@ Ptime.of_date_time ((2025, 5, 31), ((23, 59, 59), 0))

     

       42
       41
        
         in

     

       43
       43
       -
         match Query.query ~fs calendar_dir ~from ~to_ () with

     

       44
       44
       -
         | Ok events ->

     

       45
       45
       -
             let recurring_events =

     

       46
       46
       -
               List.filter

     

       47
       47
       -
                 (fun event ->

     

       48
       48
       -
                   Option.get @@ Event.get_summary event = "Recurring Event")

     

       49
       49
       -
                 events

     

       50
       50
       -
             in

     

       51
       51
       -
             Alcotest.(check bool)

     

       52
       52
       -
               "Should find multiple recurring event events" true

     

       53
       53
       -
               (List.length recurring_events > 1)

     

       54
       54
       -
         | Error _ -> Alcotest.fail "Error querying events"

     

       42
       42
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       43
       43
       +
         let events = Event.query events ~from ~to_ () in

     

       44
       44
       +
         let recurring_events =

     

       45
       45
       +
           List.filter

     

       46
       46
       +
             (fun event -> Option.get @@ Event.get_summary event = "Recurring Event")

     

       47
       47
       +
             events

     

       48
       48
       +
         in

     

       49
       49
       +
         Alcotest.(check bool)

     

       50
       50
       +
           "Should find multiple recurring event events" true

     

       51
       51
       +
           (List.length recurring_events > 1)

     

       55
       52
        
       

     

       56
       53
        
       let test_text_search ~fs () =

     

       57
       54
        
         let calendar_dir =

     

       58
       55
        
           Result.get_ok @@ Calendar_dir.create ~fs calendar_dir_path

     

       59
       56
        
         in

     

       60
       60
       -
         let filter = Query.summary_contains "Test" in

     

       57
       57
       +
         let filter = Event.summary_contains "Test" in

     

       61
       58
        
         let from =

     

       62
       59
        
           Some (Option.get @@ Ptime.of_date_time ((2025, 01, 01), ((0, 0, 0), 0)))

     

       63
       60
        
         in

     

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

     

       65
       65
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       66
       66
       -
         | Ok events ->

     

       67
       67
       -
             Alcotest.(check int)

     

       68
       68
       -
               "Should find event with 'Test' in summary" 2 (List.length events)

     

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

     

       70
       70
       -
         let filter = Query.location_contains "Weekly" in

     

       71
       71
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       72
       72
       -
         | Ok events ->

     

       73
       73
       -
             Alcotest.(check int)

     

       74
       74
       -
               "Should find event with 'Weekly' in location" 10 (List.length events)

     

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

     

       62
       62
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       63
       63
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       64
       64
       +
          Alcotest.(check int)

     

       65
       65
       +
            "Should find event with 'Test' in summary" 2 (List.length events));

     

       66
       66
       +
         let filter = Event.location_contains "Weekly" in

     

       67
       67
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       68
       68
       +
          Alcotest.(check int)

     

       69
       69
       +
            "Should find event with 'Weekly' in location" 10 (List.length events));

     

       76
       70
        
         let filter =

     

       77
       77
       -
           Query.and_filter

     

       78
       78
       -
             [ Query.summary_contains "Test"; Query.description_contains "test" ]

     

       71
       71
       +
           Event.and_filter

     

       72
       72
       +
             [ Event.summary_contains "Test"; Event.description_contains "test" ]

     

       79
       73
        
         in

     

       80
       80
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       81
       81
       -
         | Ok events ->

     

       82
       82
       -
             Alcotest.(check int)

     

       83
       83
       -
               "Should find events matching combined and criteria" 2

     

       84
       84
       -
               (List.length events)

     

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

     

       74
       74
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       75
       75
       +
          Alcotest.(check int)

     

       76
       76
       +
            "Should find events matching combined and criteria" 2 (List.length events));

     

       86
       77
        
         let filter =

     

       87
       87
       -
           Query.or_filter

     

       88
       88
       -
             [ Query.summary_contains "Test"; Query.location_contains "Weekly" ]

     

       78
       78
       +
           Event.or_filter

     

       79
       79
       +
             [ Event.summary_contains "Test"; Event.location_contains "Weekly" ]

     

       89
       80
        
         in

     

       90
       90
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       91
       91
       -
         | Ok events ->

     

       92
       92
       -
             Alcotest.(check int)

     

       93
       93
       -
               "Should find events matching combined or criteria" 12

     

       94
       94
       -
               (List.length events)

     

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

     

       81
       81
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       82
       82
       +
          Alcotest.(check int)

     

       83
       83
       +
            "Should find events matching combined or criteria" 12 (List.length events));

     

       96
       84
        
         ()

     

       97
       85
        
       

     

       98
       86
        
       let test_calendar_filter ~fs () =

     
···

       104
       92
        
         in

     

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

     

       106
       94
        
         let calendar_name = "example" in

     

       107
       107
       -
         let filter = Query.in_calendars [ calendar_name ] in

     

       108
       108
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       109
       109
       -
         | Ok events ->

     

       110
       110
       -
             let all_match_calendar =

     

       111
       111
       -
               List.for_all

     

       112
       112
       -
                 (fun e ->

     

       113
       113
       -
                   match Event.get_calendar_name e with id -> id = calendar_name)

     

       114
       114
       -
                 events

     

       115
       115
       -
             in

     

       116
       116
       -
             Alcotest.(check bool)

     

       117
       117
       -
               (Printf.sprintf "All events should be from calendar '%s'" calendar_name)

     

       118
       118
       -
               true all_match_calendar;

     

       119
       119
       -
             Alcotest.(check int) "Should find events" 2 (List.length events)

     

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

     

       95
       95
       +
         let filter = Event.in_calendars [ calendar_name ] in

     

       96
       96
       +
         let events = Result.get_ok @@ Calendar_dir.get_events ~fs calendar_dir in

     

       97
       97
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       98
       98
       +
          let all_match_calendar =

     

       99
       99
       +
            List.for_all

     

       100
       100
       +
              (fun e ->

     

       101
       101
       +
                match Event.get_calendar_name e with id -> id = calendar_name)

     

       102
       102
       +
              events

     

       103
       103
       +
          in

     

       104
       104
       +
          Alcotest.(check bool)

     

       105
       105
       +
            (Printf.sprintf "All events should be from calendar '%s'" calendar_name)

     

       106
       106
       +
            true all_match_calendar;

     

       107
       107
       +
          Alcotest.(check int) "Should find events" 2 (List.length events));

     

       121
       108
        
         let calendar_names = [ "example"; "recurrence" ] in

     

       122
       122
       -
         let filter = Query.in_calendars calendar_names in

     

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

     

       124
       124
       -
         | Ok events ->

     

       125
       125
       -
             Alcotest.(check int) "Should find events" 791 (List.length events)

     

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

     

       127
       127
       -
         let filter = Query.in_calendars [ "non-existent-calendar" ] in

     

       128
       128
       -
         (match Query.query ~fs calendar_dir ~from ~to_ ~filter () with

     

       129
       129
       -
         | Ok events ->

     

       130
       130
       -
             Alcotest.(check int)

     

       131
       131
       -
               "Should find 0 events for non-existent calendar" 0 (List.length events)

     

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

     

       109
       109
       +
         let filter = Event.in_calendars calendar_names in

     

       110
       110
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       111
       111
       +
          Alcotest.(check int) "Should find events" 791 (List.length events));

     

       112
       112
       +
         let filter = Event.in_calendars [ "non-existent-calendar" ] in

     

       113
       113
       +
         (let events = Event.query events ~from ~to_ ~filter () in

     

       114
       114
       +
          Alcotest.(check int)

     

       115
       115
       +
            "Should find 0 events for non-existent calendar" 0 (List.length events));

     

       133
       116
        
         ()

     

       134
       117
        
       

     

       135
       118
        
       let test_events ~fs =

     
···

       177
       160
        
       

     

       178
       161
        
       let test_case_insensitive_search ~fs () =

     

       179
       162
        
         (* Test lowercase query for an uppercase word *)

     

       180
       180
       -
         let lowercase_filter = Query.summary_contains "important" in

     

       163
       163
       +
         let lowercase_filter = Event.summary_contains "important" in

     

       181
       164
        
         let matches =

     

       182
       165
        
           List.filter

     

       183
       183
       -
             (fun e -> Query.matches_filter e lowercase_filter)

     

       166
       166
       +
             (fun e -> Event.matches_filter e lowercase_filter)

     

       184
       167
        
             (test_events ~fs)

     

       185
       168
        
         in

     

       186
       169
        
         Alcotest.(check bool)

     

       187
       170
        
           "Lowercase query should match uppercase text in summary" true

     

       188
       171
        
           (contains_summary matches "IMPORTANT Meeting");

     

       189
       172
        
         (* Test uppercase query for a lowercase word *)

     

       190
       190
       -
         let uppercase_filter = Query.description_contains "WEEKLY" in

     

       173
       173
       +
         let uppercase_filter = Event.description_contains "WEEKLY" in

     

       191
       174
        
         let matches =

     

       192
       175
        
           List.filter

     

       193
       193
       -
             (fun e -> Query.matches_filter e uppercase_filter)

     

       176
       176
       +
             (fun e -> Event.matches_filter e uppercase_filter)

     

       194
       177
        
             (test_events ~fs)

     

       195
       178
        
         in

     

       196
       179
        
         Alcotest.(check bool)

     
···

       199
       182
        
       

     

       200
       183
        
       let test_partial_word_matching ~fs () =

     

       201
       184
        
         (* Test searching for part of a word *)

     

       202
       202
       -
         let partial_filter = Query.summary_contains "Conf" in

     

       185
       185
       +
         let partial_filter = Event.summary_contains "Conf" in

     

       203
       186
        
         (* Should match "Conference" *)

     

       204
       187
        
         let matches =

     

       205
       188
        
           List.filter

     

       206
       206
       -
             (fun e -> Query.matches_filter e partial_filter)

     

       189
       189
       +
             (fun e -> Event.matches_filter e partial_filter)

     

       207
       190
        
             (test_events ~fs)

     

       208
       191
        
         in

     

       209
       192
        
         Alcotest.(check bool)

     

       210
       193
        
           "Partial query should match full word in summary" true

     

       211
       194
        
           (contains_summary matches "Conference Call");

     

       212
       195
        
         (* Test another partial word in description *)

     

       213
       213
       -
         let partial_filter = Query.description_contains "nation" in

     

       196
       196
       +
         let partial_filter = Event.description_contains "nation" in

     

       214
       197
        
         (* Should match "International" *)

     

       215
       198
        
         let matches =

     

       216
       199
        
           List.filter

     

       217
       217
       -
             (fun e -> Query.matches_filter e partial_filter)

     

       200
       200
       +
             (fun e -> Event.matches_filter e partial_filter)

     

       218
       201
        
             (test_events ~fs)

     

       219
       202
        
         in

     

       220
       203
        
         Alcotest.(check bool)

     
···

       228
       211
        
       let test_boolean_logic ~fs () =

     

       229
       212
        
         (* Test AND filter *)

     

       230
       213
        
         let and_filter =

     

       231
       231
       -
           Query.and_filter

     

       232
       232
       -
             [ Query.summary_contains "Meeting"; Query.description_contains "project" ]

     

       214
       214
       +
           Event.and_filter

     

       215
       215
       +
             [ Event.summary_contains "Meeting"; Event.description_contains "project" ]

     

       233
       216
        
         in

     

       234
       217
        
         let matches =

     

       235
       235
       -
           List.filter (fun e -> Query.matches_filter e and_filter) (test_events ~fs)

     

       218
       218
       +
           List.filter (fun e -> Event.matches_filter e and_filter) (test_events ~fs)

     

       236
       219
        
         in

     

       237
       220
        
         Alcotest.(check int)

     

       238
       221
        
           "AND filter should match events with both terms" 2

     
···

       240
       223
        
           (List.length matches);

     

       241
       224
        
         (* Test OR filter *)

     

       242
       225
        
         let or_filter =

     

       243
       243
       -
           Query.or_filter

     

       244
       244
       -
             [ Query.summary_contains "Workshop"; Query.summary_contains "Conference" ]

     

       226
       226
       +
           Event.or_filter

     

       227
       227
       +
             [ Event.summary_contains "Workshop"; Event.summary_contains "Conference" ]

     

       245
       228
        
         in

     

       246
       229
        
         let matches =

     

       247
       247
       -
           List.filter (fun e -> Query.matches_filter e or_filter) (test_events ~fs)

     

       230
       230
       +
           List.filter (fun e -> Event.matches_filter e or_filter) (test_events ~fs)

     

       248
       231
        
         in

     

       249
       232
        
         Alcotest.(check int)

     

       250
       233
        
           "OR filter should match events with either term"

     
···

       252
       235
        
           (List.length matches);

     

       253
       236
        
       

     

       254
       237
        
         (* Test NOT filter *)

     

       255
       255
       -
         let not_filter = Query.not_filter (Query.summary_contains "Meeting") in

     

       238
       238
       +
         let not_filter = Event.not_filter (Event.summary_contains "Meeting") in

     

       256
       239
        
         let matches =

     

       257
       257
       -
           List.filter (fun e -> Query.matches_filter e not_filter) (test_events ~fs)

     

       240
       240
       +
           List.filter (fun e -> Event.matches_filter e not_filter) (test_events ~fs)

     

       258
       241
        
         in

     

       259
       242
        
         Alcotest.(check int)

     

       260
       243
        
           "NOT filter should match events without the term"

     
···

       262
       245
        
           (List.length matches);

     

       263
       246
        
         (* Test complex combination: (Meeting AND project) OR Workshop BUT NOT Conference *)

     

       264
       247
        
         let complex_filter =

     

       265
       265
       -
           Query.and_filter

     

       248
       248
       +
           Event.and_filter

     

       266
       249
        
             [

     

       267
       267
       -
               Query.or_filter

     

       250
       250
       +
               Event.or_filter

     

       268
       251
        
                 [

     

       269
       269
       -
                   Query.and_filter

     

       252
       252
       +
                   Event.and_filter

     

       270
       253
        
                     [

     

       271
       271
       -
                       Query.summary_contains "Meeting";

     

       272
       272
       -
                       Query.description_contains "project";

     

       254
       254
       +
                       Event.summary_contains "Meeting";

     

       255
       255
       +
                       Event.description_contains "project";

     

       273
       256
        
                     ];

     

       274
       274
       -
                   Query.summary_contains "Workshop";

     

       257
       257
       +
                   Event.summary_contains "Workshop";

     

       275
       258
        
                 ];

     

       276
       276
       -
               Query.not_filter (Query.summary_contains "Conference");

     

       259
       259
       +
               Event.not_filter (Event.summary_contains "Conference");

     

       277
       260
        
             ]

     

       278
       261
        
         in

     

       279
       262
        
         let matches =

     

       280
       263
        
           List.filter

     

       281
       281
       -
             (fun e -> Query.matches_filter e complex_filter)

     

       264
       264
       +
             (fun e -> Event.matches_filter e complex_filter)

     

       282
       265
        
             (test_events ~fs)

     

       283
       266
        
         in

     

       284
       267
        
         Alcotest.(check int)

     
···

       289
       272
        
       let test_cross_field_search ~fs () =

     

       290
       273
        
         (* Search for a term that appears in multiple fields across different events *)

     

       291
       274
        
         let term_filter =

     

       292
       292
       -
           Query.or_filter

     

       275
       275
       +
           Event.or_filter

     

       293
       276
        
             [

     

       294
       294
       -
               Query.summary_contains "meeting";

     

       295
       295
       -
               Query.description_contains "meeting";

     

       296
       296
       -
               Query.location_contains "meeting";

     

       277
       277
       +
               Event.summary_contains "meeting";

     

       278
       278
       +
               Event.description_contains "meeting";

     

       279
       279
       +
               Event.location_contains "meeting";

     

       297
       280
        
             ]

     

       298
       281
        
         in

     

       299
       282
        
         let matches =

     

       300
       300
       -
           List.filter (fun e -> Query.matches_filter e term_filter) (test_events ~fs)

     

       283
       283
       +
           List.filter (fun e -> Event.matches_filter e term_filter) (test_events ~fs)

     

       301
       284
        
         in

     

       302
       285
        
         Alcotest.(check int)

     

       303
       286
        
           "Cross-field search should find all occurrences"

     
···

       305
       288
        
           (List.length matches);

     

       306
       289
        
         (* Another test with a different term *)

     

       307
       290
        
         let term_filter =

     

       308
       308
       -
           Query.or_filter

     

       291
       291
       +
           Event.or_filter

     

       309
       292
        
             [

     

       310
       310
       -
               Query.summary_contains "conference";

     

       311
       311
       -
               Query.description_contains "conference";

     

       312
       312
       -
               Query.location_contains "conference";

     

       293
       293
       +
               Event.summary_contains "conference";

     

       294
       294
       +
               Event.description_contains "conference";

     

       295
       295
       +
               Event.location_contains "conference";

     

       313
       296
        
             ]

     

       314
       297
        
         in

     

       315
       298
        
         let matches =

     

       316
       316
       -
           List.filter (fun e -> Query.matches_filter e term_filter) (test_events ~fs)

     

       299
       299
       +
           List.filter (fun e -> Event.matches_filter e term_filter) (test_events ~fs)

     

       317
       300
        
         in

     

       318
       301
        
         Alcotest.(check int)

     

       319
       302
        
           "Cross-field search should find all occurrences of 'conference'"