Compare commits
34 Commits
cbdf7e3d36
...
0d00cd5d60
| Author | SHA1 | Date | |
|---|---|---|---|
| 0d00cd5d60 | |||
| 2b5ddf06fd | |||
| 3e106a0b44 | |||
| 15a6d52876 | |||
| 3a622887dd | |||
| 5f6855e915 | |||
| f038e7f382 | |||
| 8bb075153d | |||
| be3abcb09a | |||
| cef6326289 | |||
| e3f3e91dc7 | |||
| 33660db642 | |||
| 45ce27f72b | |||
| 3739e781fa | |||
| ae6144fa7c | |||
| 922fd9a97e | |||
| 481df20d0a | |||
| da7bde38a6 | |||
| 2d856aa1cf | |||
| 717857f9a9 | |||
| 1372d330ff | |||
| 425ce06816 | |||
| c246ec6775 | |||
| 03c652260a | |||
| 7501e108ba | |||
| 28df24caa1 | |||
| b41627a288 | |||
| 35eb2b99e2 | |||
| fafdd8c142 | |||
| 98d57826fe | |||
| 139893f2e6 | |||
| 0a9f5ce265 | |||
| 4945606421 | |||
| 85733544f6 |
74
.gitea/workflows/release.yml
Normal file
74
.gitea/workflows/release.yml
Normal file
@@ -0,0 +1,74 @@
|
||||
name: Release Binaries
|
||||
|
||||
on:
|
||||
release:
|
||||
types: [published]
|
||||
|
||||
jobs:
|
||||
build:
|
||||
runs-on: ${{ matrix.runner }}
|
||||
strategy:
|
||||
fail-fast: false
|
||||
|
||||
matrix:
|
||||
include:
|
||||
- arch: amd64
|
||||
platform: linux/amd64
|
||||
image: ocaml/opam:ubuntu-22.04-ocaml-5.4
|
||||
runner: linux-amd64
|
||||
static: ""
|
||||
upx_install: "sudo apt install -y upx"
|
||||
- arch: arm64
|
||||
platform: linux/arm64
|
||||
image: ocaml/opam:alpine-ocaml-5.4
|
||||
runner: linux-arm64
|
||||
static: "OCAMLPARAM='_,ccopt=-static,cclib=-static'"
|
||||
upx_install: "sudo apk add upx"
|
||||
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Build (${{ matrix.arch }})
|
||||
run: |
|
||||
set -o pipefail
|
||||
|
||||
# Crea il container senza avviarlo
|
||||
CID=$(docker create \
|
||||
--platform ${{ matrix.platform }} \
|
||||
-w /src \
|
||||
${{ matrix.image }} \
|
||||
sleep infinity)
|
||||
|
||||
# Copia i sorgenti dentro con docker cp (funziona anche in DinD)
|
||||
docker cp "${{ github.workspace }}/." "$CID:/src"
|
||||
|
||||
# Avvia ed esegui la build
|
||||
docker start "$CID"
|
||||
docker exec "$CID" bash -c "
|
||||
${{ matrix.upx_install }}
|
||||
sudo chown -R opam:opam /src
|
||||
opam update
|
||||
opam install . --deps-only -y --no-depexts
|
||||
${{ matrix.static }} opam exec -- dune build @install --release
|
||||
opam exec -- dune install --prefix /src/dist
|
||||
upx /src/dist/bin/ical2rem
|
||||
" 2>&1 | cat
|
||||
|
||||
# Copia il binario fuori
|
||||
docker cp "$CID:/src/dist/bin/ical2rem" \
|
||||
"${{ github.workspace }}/ical2rem-linux-${{ matrix.arch }}"
|
||||
|
||||
docker rm -f "$CID"
|
||||
|
||||
- name: Carica artefatto sulla release
|
||||
env:
|
||||
TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||
RELEASE_ID: ${{ github.event.release.id }}
|
||||
run: |
|
||||
FILENAME="ical2rem-linux-${{ matrix.arch }}"
|
||||
curl -s -X POST \
|
||||
"${{ github.server_url }}/api/v1/repos/${{ github.repository }}/releases/${RELEASE_ID}/assets?name=${FILENAME}" \
|
||||
-H "Authorization: token ${TOKEN}" \
|
||||
-H "Content-Type: application/octet-stream" \
|
||||
--data-binary "@${FILENAME}"
|
||||
214
README.md
214
README.md
@@ -1,3 +1,213 @@
|
||||
# remind-sync
|
||||
# ical2rem
|
||||
|
||||
Convert iCalendar (`.ics`) files into [Remind](https://dianne.skoll.ca/projects/remind/) format.
|
||||
|
||||
Designed to work on real-world calendar data (Google Calendar, SOGo, Outlook/Teams exports).
|
||||
Full RFC 5545 coverage is intentionally out of scope — see [Limitations](#limitations).
|
||||
|
||||
## Features
|
||||
|
||||
### Event types supported
|
||||
|
||||
| iCalendar pattern | Remind output |
|
||||
|---|---|
|
||||
| All-day single | `REM YYYY-MM-DD MSG …` |
|
||||
| All-day multi-day | `REM date THROUGH date MSG …` |
|
||||
| Timed event (UTC, local, TZID) | `REM date AT HH:MM DURATION HH:MM MSG …` |
|
||||
| Yearly recurrence (`FREQ=YEARLY`) | `REM MMM DD MSG …` |
|
||||
| Weekly recurrence (`FREQ=WEEKLY`) | `REM Mon Wed YYYY-MM-DD *7 UNTIL … MSG …` |
|
||||
| Daily recurrence (`FREQ=DAILY`) | `REM date *N UNTIL … MSG …` |
|
||||
| Monthly by day-of-month (`BYMONTHDAY`) | `REM N FROM … UNTIL … MSG …` |
|
||||
| Monthly by nth weekday (`BYDAY=nWD`) | `REM Wd N FROM … UNTIL … MSG …` |
|
||||
| Exceptions (`EXDATE`) | `PUSH-OMIT-CONTEXT` + `OMIT` + `SKIP` + `POP-OMIT-CONTEXT` |
|
||||
| Overrides (`RECURRENCE-ID`) | OMIT on original slot + single `REM` with new date/time |
|
||||
| Cancellations (`STATUS:CANCELLED`) | OMIT only, no REM |
|
||||
| Duration via `DURATION` instead of `DTEND` | Handled transparently |
|
||||
| Alarms (`VALARM ACTION:DISPLAY/AUDIO`) | `AT … +n` / `++n` / `SCHED` / `WARN` |
|
||||
| Conference URL (Google Meet, Teams) | `INFO "Url: …"` |
|
||||
| Windows timezone names (Outlook) | Resolved to IANA via CLDR table |
|
||||
|
||||
### Metadata lines
|
||||
|
||||
Each reminder can include optional `INFO` lines (all suppressible via flags):
|
||||
|
||||
```
|
||||
REM \
|
||||
INFO "UID: …" \
|
||||
INFO "Calendar: MYCAL" \
|
||||
INFO "Location: …" \
|
||||
INFO "Description: …" \
|
||||
INFO "Url: …" \
|
||||
…
|
||||
```
|
||||
|
||||
## Installation
|
||||
|
||||
### From source
|
||||
|
||||
Requires [opam](https://opam.ocaml.org/) and OCaml >= 5.0.
|
||||
|
||||
```bash
|
||||
git clone https://git.donadeo.net/pdonadeo/ical2rem
|
||||
cd ical2rem
|
||||
opam install . --deps-only
|
||||
dune build
|
||||
dune install
|
||||
```
|
||||
|
||||
The binary is installed as `ical2rem`.
|
||||
|
||||
### Dependencies
|
||||
|
||||
- [`icalendar`](https://github.com/roburio/icalendar) — iCal parser
|
||||
- [`timedesc`](https://github.com/daypack-dev/timere) + `timedesc-tzdb.full` + `timedesc-tzlocal.unix` — date/time + timezone handling
|
||||
- [`cmdliner`](https://erratique.ch/software/cmdliner) — CLI
|
||||
- [`ppx_deriving.show`](https://github.com/ocaml-ppx/ppx_deriving) — debug printers
|
||||
|
||||
## Usage
|
||||
|
||||
```
|
||||
ical2rem [OPTION]… FILE…
|
||||
```
|
||||
|
||||
Output goes to stdout and can be redirected to a `.rem` file.
|
||||
|
||||
Pass `-` as a filename to read from standard input. `-` may appear at most once,
|
||||
but can be freely mixed with regular files:
|
||||
|
||||
```bash
|
||||
curl https://example.com/calendar.ics | ical2rem - > calendar.rem
|
||||
ical2rem work.ics - personal.ics > all.rem
|
||||
```
|
||||
|
||||
### Examples
|
||||
|
||||
Convert a single calendar:
|
||||
```bash
|
||||
ical2rem personal.ics > personal.rem
|
||||
```
|
||||
|
||||
Convert multiple calendars into one file:
|
||||
```bash
|
||||
ical2rem work.ics personal.ics > all.rem
|
||||
```
|
||||
|
||||
Sort output chronologically (oldest first):
|
||||
```bash
|
||||
ical2rem --sort asc personal.ics > personal.rem
|
||||
```
|
||||
|
||||
Run on a server in UTC, output in a specific timezone:
|
||||
```bash
|
||||
ical2rem --timezone Europe/Rome personal.ics > personal.rem
|
||||
```
|
||||
|
||||
Strip all metadata lines from output:
|
||||
```bash
|
||||
ical2rem --no-uuid --no-source --no-location --no-description --no-conference-url personal.ics
|
||||
```
|
||||
|
||||
Use stdin as input calendar:
|
||||
```bash
|
||||
curl https://example.com/calendar.ics | ical2rem - > calendar.rem
|
||||
```
|
||||
|
||||
Override calendar name in `INFO` lines (single file only):
|
||||
```bash
|
||||
ical2rem --source "Work" work.ics > work.rem
|
||||
```
|
||||
|
||||
Show diagnostic warnings (skipped events, unsupported rules, etc.):
|
||||
```bash
|
||||
ical2rem --verbose personal.ics > personal.rem
|
||||
```
|
||||
|
||||
### All options
|
||||
|
||||
| Option | Description |
|
||||
|---|---|
|
||||
| `FILE…` | One or more `.ics` files to convert; use `-` for standard input (at most once) |
|
||||
| `-z`, `--timezone TZ` | Target timezone for output (default: local) |
|
||||
| `--sort asc\|desc\|original` | Sort order by date (default: `desc`); `original` preserves processing order (sorted by UID within each file, last file first) |
|
||||
| `--source NAME` | Override calendar name (single file only) |
|
||||
| `-v`, `--verbose` | Print diagnostic messages on stderr |
|
||||
| `--no-uuid` | Omit `INFO "UID: …"` lines |
|
||||
| `--no-source` | Omit `INFO "Calendar: …"` lines |
|
||||
| `--no-location` | Omit `INFO "Location: …"` lines |
|
||||
| `--no-description` | Omit `INFO "Description: …"` lines |
|
||||
| `--no-conference-url` | Omit `INFO "Url: …"` lines |
|
||||
| `--version` | Print version and exit |
|
||||
| `--help` | Print help and exit |
|
||||
|
||||
## Output format examples
|
||||
|
||||
### All-day single event
|
||||
|
||||
```
|
||||
REM \
|
||||
INFO "UID: abc@google.com" \
|
||||
INFO "Calendar: PERSONAL" \
|
||||
2026-06-15 MSG Birthday party
|
||||
```
|
||||
|
||||
### Timed event with alarm
|
||||
|
||||
```
|
||||
REM \
|
||||
INFO "UID: xyz@google.com" \
|
||||
INFO "Calendar: WORK" \
|
||||
2026-05-27 AT 10:00 +30 DURATION 01:00 MSG %"Team standup%" (%b %3)
|
||||
```
|
||||
|
||||
### Weekly recurrence with exception
|
||||
|
||||
```
|
||||
PUSH-OMIT-CONTEXT
|
||||
OMIT 6 Oct 2025
|
||||
REM \
|
||||
INFO "UID: …" \
|
||||
INFO "Calendar: WORK" \
|
||||
Mon 2025-09-01 *7 UNTIL 2025-12-31 SKIP AT 09:00 +15 MSG %"Standup%" (%b %3)
|
||||
POP-OMIT-CONTEXT
|
||||
```
|
||||
|
||||
### Recurring event with modified occurrence
|
||||
|
||||
```
|
||||
PUSH-OMIT-CONTEXT
|
||||
OMIT 3 Jun 2015
|
||||
REM \
|
||||
INFO "UID: …" \
|
||||
INFO "Calendar: PERSONAL" \
|
||||
Wed 1 FROM 2015-06-03 UNTIL 2015-06-09 SKIP MSG Monthly payment
|
||||
POP-OMIT-CONTEXT
|
||||
REM \
|
||||
INFO "UID: …" \
|
||||
INFO "Calendar: PERSONAL" \
|
||||
2015-06-09 MSG Monthly payment
|
||||
```
|
||||
|
||||
## Limitations
|
||||
|
||||
### Recurrence rules (`RRULE`)
|
||||
|
||||
- `FREQ=WEEKLY INTERVAL=N` (N > 1): supported (maps to `*7N`).
|
||||
- `FREQ=MONTHLY INTERVAL=N` (N > 1): **not supported**, event skipped with warning.
|
||||
- `FREQ=MONTHLY BYDAY=WD` without position (every Monday of the month): **not supported**.
|
||||
- `BYSETPOS`: **not supported**.
|
||||
- `FREQ=YEARLY` with `BYMONTH`/`BYDAY` variants: **not supported**, only simple yearly (same day every year).
|
||||
- `RDATE` (additional isolated dates): **not supported**, warning emitted.
|
||||
|
||||
### Alarms (`VALARM`)
|
||||
|
||||
- `ACTION:EMAIL`: ignored silently.
|
||||
- `TRIGGER;VALUE=DATE-TIME` (absolute datetime trigger): ignored silently.
|
||||
- Positive triggers (after the event): ignored silently.
|
||||
- `RELATED=END` triggers: the offset is applied as if it were `RELATED=START` (no warning emitted).
|
||||
- `REPEAT`/`DURATION` (repeating alarms) on all-day events: ignored.
|
||||
|
||||
### Other
|
||||
|
||||
- `ATTENDEE`, `CATEGORIES`, visibility/status fields: ignored.
|
||||
- `VTIMEZONE` components: ignored; TZID names are resolved directly via IANA or the built-in Windows→IANA CLDR table.
|
||||
|
||||
Simple program to convert iCalendar files into remind format
|
||||
@@ -1,17 +1,82 @@
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let ical_file =
|
||||
let doc = "TODO" in
|
||||
let docv = "ICAL" in
|
||||
Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv ~doc)
|
||||
let version_string () =
|
||||
match Build_info.V1.version () with
|
||||
| None -> "dev"
|
||||
| Some v -> Build_info.V1.Version.to_string v
|
||||
|
||||
let files =
|
||||
let doc = "Files to process" in
|
||||
Arg.(non_empty & pos_all string [] & info [] ~docv:"FILE" ~doc)
|
||||
|
||||
let timezone =
|
||||
let doc = "Target timezone for output (e.g. Europe/Rome). Defaults to local timezone." in
|
||||
Arg.(value & opt (some string) None & info [ "timezone"; "z" ] ~docv:"TZ" ~doc)
|
||||
|
||||
let verbose =
|
||||
let doc = "Print diagnostic messages (skipped events, unsupported recurrences, etc.) on stderr." in
|
||||
Arg.(value & flag & info [ "verbose"; "v" ] ~doc)
|
||||
|
||||
let no_uuid =
|
||||
let doc = "Omit the INFO line with the event UID from output." in
|
||||
Arg.(value & flag & info [ "no-uuid" ] ~doc)
|
||||
|
||||
let no_source =
|
||||
let doc = "Omit the INFO line with the calendar source name from output." in
|
||||
Arg.(value & flag & info [ "no-source" ] ~doc)
|
||||
|
||||
let no_location =
|
||||
let doc = "Omit the INFO line with the event location from output." in
|
||||
Arg.(value & flag & info [ "no-location" ] ~doc)
|
||||
|
||||
let no_description =
|
||||
let doc = "Omit the INFO line with the event description from output." in
|
||||
Arg.(value & flag & info [ "no-description" ] ~doc)
|
||||
|
||||
let no_conference_url =
|
||||
let doc = "Omit the INFO line with the conference URL from output." in
|
||||
Arg.(value & flag & info [ "no-conference-url" ] ~doc)
|
||||
|
||||
type sort_order = Asc | Desc | Original
|
||||
|
||||
let sort_order_enum = [ ("asc", Asc); ("desc", Desc); ("original", Original) ]
|
||||
|
||||
let sort =
|
||||
let doc = "Output sort order by date: $(b,desc) (default), $(b,asc), or $(b,original) (processing order)." in
|
||||
Arg.(value & opt (enum sort_order_enum) Desc & info [ "sort" ] ~docv:"ORDER" ~doc)
|
||||
|
||||
let source =
|
||||
let doc = "Override the calendar source name used in INFO lines. Only valid when processing a single file." in
|
||||
Arg.(value & opt (some string) None & info [ "source" ] ~docv:"NAME" ~doc)
|
||||
|
||||
type cli_args = {
|
||||
tz : string option;
|
||||
verbose : bool;
|
||||
no_uuid : bool;
|
||||
no_source : bool;
|
||||
no_location : bool;
|
||||
no_description : bool;
|
||||
no_conference_url : bool;
|
||||
sort : sort_order;
|
||||
source : string option;
|
||||
}
|
||||
|
||||
let main_command f =
|
||||
let doc = "Convert iCalendar files to remind format" in
|
||||
let man = [] in
|
||||
Cmd.make (Cmd.info "ical2rem" ~version:"%%VERSION%%" ~doc ~man)
|
||||
Cmd.make (Cmd.info "ical2rem" ~version:(version_string ()) ~doc ~man)
|
||||
@@
|
||||
let+ ical_file = ical_file in
|
||||
f ical_file
|
||||
let+ files = files
|
||||
and+ tz = timezone
|
||||
and+ verbose = verbose
|
||||
and+ no_uuid = no_uuid
|
||||
and+ no_source = no_source
|
||||
and+ no_location = no_location
|
||||
and+ no_description = no_description
|
||||
and+ no_conference_url = no_conference_url
|
||||
and+ sort = sort
|
||||
and+ source = source in
|
||||
f { tz; verbose; no_uuid; no_source; no_location; no_description; no_conference_url; sort; source } files
|
||||
|
||||
let main f = Cmd.eval @@ main_command f
|
||||
|
||||
10
bin/config.ml
Normal file
10
bin/config.ml
Normal file
@@ -0,0 +1,10 @@
|
||||
(** Global configuration flags, set once at startup from CLI args. *)
|
||||
|
||||
(** Enable diagnostic output on stderr. Off by default; activated by --verbose. *)
|
||||
let verbose = ref false
|
||||
|
||||
let no_uuid = ref false
|
||||
let no_source = ref false
|
||||
let no_location = ref false
|
||||
let no_description = ref false
|
||||
let no_conference_url = ref false
|
||||
6
bin/dune
6
bin/dune
@@ -1,11 +1,11 @@
|
||||
(executable
|
||||
(public_name remind_sync)
|
||||
(public_name ical2rem)
|
||||
(name main)
|
||||
(modules main commandLine remind eventPredicates utils)
|
||||
(modules main commandLine config remind eventPredicates utils windows_tz)
|
||||
(preprocess
|
||||
(pps ppx_deriving.show))
|
||||
(libraries
|
||||
remind_sync
|
||||
dune-build-info
|
||||
cmdliner
|
||||
icalendar
|
||||
timedesc-tzdb.full
|
||||
|
||||
@@ -1,191 +1,9 @@
|
||||
open Remind_sync
|
||||
open Icalendar
|
||||
open Utils
|
||||
|
||||
(* CASE ANALYSIS PREDICATES
|
||||
- id: P00
|
||||
pattern: Ha un SUMMARY?
|
||||
ics: "SUMMARY:…"
|
||||
remind_support: nativo
|
||||
strategia: "REM <data> MSG <summary>"
|
||||
snippet: 'REM 2025-12-25 MSG Natale'
|
||||
priorita: Subito
|
||||
|
||||
- id: P01
|
||||
pattern: All-day singolo
|
||||
ics: "DTSTART;VALUE=DATE, opzionale DTEND=giorno+1"
|
||||
remind_support: nativo
|
||||
strategia: "REM <data> MSG <summary>"
|
||||
snippet: 'REM 2025-12-25 MSG Natale'
|
||||
priorita: Subito
|
||||
|
||||
- id: P02
|
||||
pattern: All-day multi-giorno
|
||||
ics: "DTSTART;VALUE=DATE + DTEND;VALUE=DATE esclusivo"
|
||||
remind_support: nativo+accorgimenti
|
||||
strategia: "espandi in eventi giornalieri; stesso SUMMARY"
|
||||
snippet: 'REM 2025-08-10 THROUGH 2025-08-15 MSG Ferie # oppure espansione per-giorno'
|
||||
priorita: Subito
|
||||
|
||||
- id: P03
|
||||
pattern: Evento a orario locale
|
||||
ics: "DTSTART;TZID=… + DTEND oppure DURATION"
|
||||
remind_support: nativo
|
||||
strategia: "REM <data> AT <hh:mm> [DURATION] MSG …"
|
||||
snippet: 'REM 2025-10-05 AT 09:00 DURATION 1:00 MSG Riunione'
|
||||
priorita: Subito
|
||||
|
||||
- id: P04
|
||||
pattern: Evento a orario in UTC
|
||||
ics: "DTSTART/DTEND con suffisso Z"
|
||||
remind_support: nativo+accorgimenti
|
||||
strategia: "converti a fuso locale prima di emettere AT"
|
||||
snippet: 'REM 2025-09-03 AT 06:45 MSG Treno'
|
||||
priorita: Subito
|
||||
|
||||
- id: P05
|
||||
pattern: Ricorrenza settimanale semplice
|
||||
ics: "RRULE:FREQ=WEEKLY;BYDAY=…;[UNTIL|COUNT]"
|
||||
remind_support: nativo
|
||||
strategia: "REM <giorni> FROM <start> [UNTIL <end>] AT <hh:mm> MSG …"
|
||||
snippet: 'REM Mon Wed FROM 2025-09-01 UNTIL 2025-10-31 AT 09:00 MSG Standup'
|
||||
priorita: Subito
|
||||
|
||||
- id: P06
|
||||
pattern: Ricorrenza giornaliera semplice
|
||||
ics: "RRULE:FREQ=DAILY;[UNTIL|COUNT]"
|
||||
remind_support: nativo
|
||||
strategia: "REM FROM <start> UNTIL <end> AT <hh:mm> EVERY 1 MSG …"
|
||||
snippet: 'REM FROM 2025-10-01 UNTIL 2025-10-10 AT 08:30 MSG Daily'
|
||||
priorita: Subito
|
||||
|
||||
- id: P07
|
||||
pattern: Ricorrenza mensile per giorno fisso
|
||||
ics: "RRULE:FREQ=MONTHLY;BYMONTHDAY=…"
|
||||
remind_support: nativo
|
||||
strategia: "REM <giorno-num> AT <hh:mm> FROM/UNTIL"
|
||||
snippet: 'REM 15 AT 10:00 FROM 2025-01-01 MSG Fatture'
|
||||
priorita: Dopo
|
||||
|
||||
- id: P08
|
||||
pattern: Ricorrenza “n-esimo weekday” del mese
|
||||
ics: "RRULE:FREQ=MONTHLY;BYDAY=MO;BYSETPOS=3"
|
||||
remind_support: espansione
|
||||
strategia: "materializza occorrenze in singoli REM o calcola in codice"
|
||||
snippet: '# genera REM per ciascuna data calcolata'
|
||||
priorita: Dopo
|
||||
|
||||
- id: P09
|
||||
pattern: Ricorrenza annuale semplice
|
||||
ics: "RRULE:FREQ=YEARLY;[BYMONTH][BYMONTHDAY]"
|
||||
remind_support: nativo
|
||||
strategia: "REM <data ricorrente> MSG …"
|
||||
snippet: 'REM Jul 29 MSG Compleanno'
|
||||
priorita: Dopo
|
||||
|
||||
- id: P10
|
||||
pattern: Eccezioni
|
||||
ics: "EXDATE (una o più), RDATE aggiuntive"
|
||||
remind_support: nativo+accorgimenti
|
||||
strategia: "usa OMIT per rimuovere date; aggiungi REM singoli per RDATE"
|
||||
snippet: 'REM Mon AT 09:00 FROM 2025-09-01 UNTIL 2025-10-31 MSG Standup\nOMIT 2025-10-13'
|
||||
priorita: Subito
|
||||
|
||||
- id: P11
|
||||
pattern: Override/cancellazioni per istanza
|
||||
ics: "RECURRENCE-ID con contenuto modificato o STATUS:CANCELLED"
|
||||
remind_support: espansione
|
||||
strategia: "OMIT la data dalla serie; aggiungi REM singolo con i campi override"
|
||||
snippet: '# serie + REM specifico per l’istanza'
|
||||
priorita: Subito
|
||||
|
||||
- id: P12
|
||||
pattern: DURATION al posto di DTEND
|
||||
ics: "DURATION:PT…"
|
||||
remind_support: nativo
|
||||
strategia: "mappa su DURATION <h:mm> in REM"
|
||||
snippet: 'REM 2025-10-05 AT 14:00 DURATION 2:30 MSG Workshop'
|
||||
priorita: Subito
|
||||
|
||||
- id: P13
|
||||
pattern: Allarmi
|
||||
ics: "VALARM DISPLAY/AUDIO/EMAIL; TRIGGER relativo"
|
||||
remind_support: parziale
|
||||
strategia: "mappa 1 allarme principale su WARN; multipli opzionali come REM duplicati HIDE"
|
||||
snippet: 'REM 2025-10-05 AT 09:00 WARN 15 MSG Riunione'
|
||||
priorita: Dopo
|
||||
|
||||
- id: P14
|
||||
pattern: Fusi orari dichiarati (VTIMEZONE, TZID diversi)
|
||||
ics: "VTIMEZONE + DTSTART;TZID=…"
|
||||
remind_support: nativo+accorgimenti
|
||||
strategia: "normalizza tutto al fuso locale del sistema prima dell’output"
|
||||
snippet: '# conversione in pre-processing'
|
||||
priorita: Subito
|
||||
|
||||
- id: P15
|
||||
pattern: Partecipanti/organizzatore
|
||||
ics: "ORGANIZER, ATTENDEE*, PARTSTAT…"
|
||||
remind_support: non previsto
|
||||
strategia: "appendi a DESCRIPTION/MSG come testo"
|
||||
snippet: '# nessuna semantica in Remind'
|
||||
priorita: Quando serve
|
||||
|
||||
- id: P16
|
||||
pattern: Allegati/URL esterni
|
||||
ics: "ATTACH, URL"
|
||||
remind_support: non previsto
|
||||
strategia: "conserva URL in coda al MSG"
|
||||
snippet: '# link nel testo'
|
||||
priorita: Quando serve
|
||||
|
||||
- id: P17
|
||||
pattern: Meeting online (Google/Teams metadati)
|
||||
ics: "X-GOOGLE-CONFERENCE, X-MICROSOFT-*"
|
||||
remind_support: non previsto
|
||||
strategia: "estrai solo URL di join nel MSG"
|
||||
snippet: '# riduci al link'
|
||||
priorita: Quando serve
|
||||
|
||||
- id: P18
|
||||
pattern: Visibilità/trasparenza
|
||||
ics: "CLASS, TRANSP"
|
||||
remind_support: non previsto
|
||||
strategia: "ignora o aggiungi prefisso [FREE]/[BUSY] nel MSG"
|
||||
snippet: '# opzionale'
|
||||
priorita: Ignora
|
||||
|
||||
- id: P19
|
||||
pattern: Stato/versioning
|
||||
ics: "STATUS, SEQUENCE, CREATED, LAST-MODIFIED"
|
||||
remind_support: non previsto
|
||||
strategia: "ignora; usa solo STATUS:CANCELLED per soppressioni"
|
||||
snippet: '# già coperto in P11'
|
||||
priorita: Ignora
|
||||
|
||||
- id: P20
|
||||
pattern: Categorie/etichette
|
||||
ics: "CATEGORIES:…"
|
||||
remind_support: parziale
|
||||
strategia: "prefisso nel MSG o uso TAG se ti serve filtrare"
|
||||
snippet: 'REM 2025-10-05 AT 09:00 TAG Work MSG [Work] Riunione'
|
||||
priorita: Dopo
|
||||
*)
|
||||
|
||||
type event_description =
|
||||
[ `Collect_uuid
|
||||
| `Has_summary
|
||||
| `All_day_event
|
||||
| `Expand_recurrence
|
||||
| `Yearly_simple_date
|
||||
| `Simple_weekly_recurrence ]
|
||||
[@@deriving show]
|
||||
|
||||
type error = Invalid_date of string | Skip [@@deriving show]
|
||||
|
||||
let invalid_date s e =
|
||||
Error (Invalid_date (spf "Invalid date: %s, error: %s" s (Remind_sync.Timedesc.Date.Ymd.show_error e)))
|
||||
type error = Invalid_date of string | Skip
|
||||
|
||||
let invalid_date s e = Error (Invalid_date (spf "Invalid date: %s, error: %s" s (show_error e)))
|
||||
let skip = Error Skip
|
||||
|
||||
type collector = Remind.rem -> event -> (Remind.rem, error) result
|
||||
@@ -206,6 +24,24 @@ let collect_summary rem ev : (Remind.rem, error) result =
|
||||
| Some s -> Ok { rem with Remind.summary = s }
|
||||
| None -> Ok { rem with Remind.summary = "" }
|
||||
|
||||
let collect_location rem ev : (Remind.rem, error) result =
|
||||
let location_opt = Utils.get_location ev in
|
||||
match location_opt with
|
||||
| Some loc -> Ok { rem with Remind.location = Some loc }
|
||||
| None -> Ok rem
|
||||
|
||||
let collect_description rem ev : (Remind.rem, error) result =
|
||||
let description_opt = Utils.get_description ev in
|
||||
match description_opt with
|
||||
| Some desc -> Ok { rem with Remind.description = Some desc }
|
||||
| None -> Ok rem
|
||||
|
||||
let collect_conference_url rem ev : (Remind.rem, error) result =
|
||||
let conference_url_opt = Utils.get_conference_url ev in
|
||||
match conference_url_opt with
|
||||
| Some url -> Ok { rem with Remind.conference_url = Some url }
|
||||
| None -> Ok rem
|
||||
|
||||
let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
||||
let _, dtstart = ev.dtstart in
|
||||
match dtstart with
|
||||
@@ -215,21 +51,38 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
||||
| Ok day_start ->
|
||||
begin match ev.dtend_or_duration with
|
||||
| None -> { rem with Remind.date = day_start } |> Result.ok
|
||||
| Some (`Dtend (_, `Datetime _)) -> skip
|
||||
| Some (`Dtend (_, `Datetime _)) ->
|
||||
Utils.warn "Warning: DTSTART is DATE but DTEND is DATETIME, skipping (UID: %s)\n" rem.Remind.original_uuid;
|
||||
skip
|
||||
| Some (`Dtend (_, `Date (year, month, day))) ->
|
||||
begin match Timedesc.Date.Ymd.make ~year ~month ~day with
|
||||
| Error e -> invalid_date "DTEND" e
|
||||
| Ok day_end ->
|
||||
let day_end = Timedesc.Date.add ~days:(-1) day_end in
|
||||
let day_end =
|
||||
if Timedesc.Date.lt day_start day_end then Timedesc.Date.add ~days:(-1) day_end else day_end
|
||||
in
|
||||
if Timedesc.Date.diff_days day_end day_start = 0 then
|
||||
Ok { rem with Remind.date = day_start; Remind.end_date = None }
|
||||
else Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end }
|
||||
end
|
||||
| Some (`Duration (_, _duration)) -> skip
|
||||
| Some (`Duration (_, duration)) ->
|
||||
(* DATE + DURATION: compute end_date as start + duration_in_days - 1 *)
|
||||
let days, _ = Ptime.Span.to_d_ps duration in
|
||||
if days <= 1 then Ok { rem with Remind.date = day_start; Remind.end_date = None }
|
||||
else
|
||||
let day_end = Timedesc.Date.add ~days:(days - 1) day_start in
|
||||
Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end }
|
||||
end)
|
||||
| `Datetime datetime -> begin
|
||||
let start_td = Utils.timedesc_of_timestamp datetime in
|
||||
let rem = { rem with Remind.date = Timedesc.date start_td; Remind.time = Some (Timedesc.time start_td) } in
|
||||
let rem =
|
||||
{
|
||||
rem with
|
||||
Remind.date = Timedesc.date start_td;
|
||||
Remind.time = Some (Timedesc.time start_td);
|
||||
Remind.tz = Some (Timedesc.tz start_td);
|
||||
}
|
||||
in
|
||||
|
||||
match ev.dtend_or_duration with
|
||||
| None -> Ok rem
|
||||
@@ -243,7 +96,9 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
||||
let rem = { rem with Remind.duration = Some duration } in
|
||||
Ok rem
|
||||
end
|
||||
| `Date (_year, _month, _day) -> skip
|
||||
| `Date (_year, _month, _day) ->
|
||||
Utils.warn "Warning: DTSTART is DATETIME but DTEND is DATE, skipping (UID: %s)\n" rem.Remind.original_uuid;
|
||||
skip
|
||||
end
|
||||
| Some (`Duration (_, duration)) ->
|
||||
let span = Timedesc.Utils.span_of_ptime_span duration in
|
||||
@@ -251,84 +106,162 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
||||
Ok rem
|
||||
end
|
||||
|
||||
let expand_recurrence rem ev : (Remind.rem, error) result =
|
||||
if List.length rem.Remind.recurring > 0 then skip else Ok rem
|
||||
let collect_exdates rem ev : (Remind.rem, error) result =
|
||||
let exdates = Utils.get_exdates ev in
|
||||
Ok { rem with Remind.exdate = exdates }
|
||||
|
||||
let collect_triggers rem ev : (Remind.rem, error) result =
|
||||
let triggers = Utils.get_triggers ev in
|
||||
Ok { rem with Remind.triggers }
|
||||
|
||||
let yearly_simple_date rem ev : (Remind.rem, error) result =
|
||||
match ev.rrule with
|
||||
| Some (_, (`Yearly, None, None, [])) ->
|
||||
let month, day = (Timedesc.Date.month rem.Remind.date, Timedesc.Date.day rem.Remind.date) in
|
||||
Ok { rem with Remind.simple_yearly = Some (month, day) }
|
||||
Ok { rem with Remind.yearly = Some (month, day) }
|
||||
| Some _ -> Ok rem
|
||||
| None -> Ok rem
|
||||
|
||||
let simple_weekly_recurrence rem ev : (Remind.rem, error) result =
|
||||
(*
|
||||
type recur =
|
||||
[ `Byminute of int list
|
||||
| `Byday of (int * weekday) list
|
||||
| `Byhour of int list
|
||||
| `Bymonth of int list
|
||||
| `Bymonthday of int list
|
||||
| `Bysecond of int list
|
||||
| `Bysetposday of int list
|
||||
| `Byweek of int list
|
||||
| `Byyearday of int list
|
||||
| `Weekday of weekday ]
|
||||
[@@deriving show]
|
||||
|
||||
type freq = [ `Daily | `Hourly | `Minutely | `Monthly | `Secondly | `Weekly | `Yearly ] [@@deriving show]
|
||||
type count_or_until = [ `Count of int | `Until of utc_or_timestamp_local (* TODO date or datetime *) ] [@@deriving show]
|
||||
type interval = int [@@deriving show]
|
||||
type recurrence = freq * count_or_until option * interval option * recur list [@@deriving show]
|
||||
|
||||
QUESTE SONO **TUTTE** LE RRULE NEL MIO DATASET
|
||||
|
||||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0b48208b22php2mv6r157rk23v@google.com
|
||||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0cb95edhq1d00bd3gcpomb9mcg@google.com
|
||||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0kbt3i5d6dpq6uncmhlcr335vq@google.com
|
||||
RRULE: (`Daily, (Some `Until (`Utc (2008-05-11 11:15:00 +00:00))), None, [`Weekday (`Monday)]) UID: dmkfr0h3p1fq6p6v8i62vm1n4k@google.com
|
||||
RRULE: (`Daily, (Some `Until (`Utc (2008-05-11 15:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: bh5mhev3uq6p5casisrqufksd8@google.com
|
||||
RRULE: (`Daily, (Some `Until (`Utc (2014-12-24 22:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: tsdjd2jlcsgi0c0ei1celg41v4@google.com
|
||||
RRULE: (`Daily, (Some `Until (`Utc (2014-12-25 10:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: ha0rjkp62uqh3boc9n6k4f6cuo@google.com
|
||||
RRULE: (`Daily, (Some `Until (`Utc (2025-05-22 07:00:00 +00:00))), (Some 1), []) UID: 040000008200E00074C5B7101A82E008000000008FD3AF9B24B9DB01000000000000000010000000A152B8147DB736439366702297C68F98
|
||||
RRULE: (`Daily, (Some `Until (`Utc (2026-02-04 13:30:00 +00:00))), (Some 1), []) UID: 040000008200E00074C5B7101A82E00800000000CEF108493A94DC010000000000000000100000005D7F32754B6575419990179984830EFC
|
||||
RRULE: (`Weekly, (Some `Count (3)), None, [`Byday ([(0, `Wednesday)])]) UID: 605de987-4600-419f-a40a-eb585b7e1ba2
|
||||
RRULE: (`Weekly, (Some `Count (7)), (Some 2), [`Byday ([(0, `Tuesday)])]) UID: 13C-6A06C880-D-48221A00
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2009-07-31 18:00:00 +00:00))), None, [`Byday ([(0, `Tuesday); (0, `Friday)]); `Weekday (`Monday)]) UID: hrpg4ovdou2ae57pqb9niobb3c@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2013-04-18 17:30:00 +00:00))), None, [`Byday ([(0, `Monday); (0, `Thursday)])]) UID: ool8g85jgfd5db57mdqbkt52nk@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2014-12-20 10:30:00 +00:00))), None, [`Byday ([(0, `Saturday)])]) UID: rr96e7fr98g8j9vner8mmdtfls@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2020-09-16 21:59:59 +00:00))), None, [`Byday ([(0, `Thursday)])]) UID: 5n174r33j7ep7t5eete9307949@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2021-08-25 21:59:59 +00:00))), None, [`Byday ([(0, `Wednesday)]); `Weekday (`Monday)]) UID: 20kb6se0oog5e9hi5l7uu6jiq6@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2021-09-18 21:59:59 +00:00))), (Some 1), [`Byday ([(0, `Sunday)]); `Weekday (`Monday)]) UID: 6sp30e9oc4sjebb264o3gb9kcos3ab9pccoj2b9j6kom2chjcco6ad9nck@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2024-06-12 08:00:00 +00:00))), (Some 4), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])]) UID: 040000008200E00074C5B7101A82E00800000000DD1EB23CE8ACDA01000000000000000010000000FED71D085A97144F8C716EC999301E3A
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2025-02-04 22:59:59 +00:00))), (Some 1), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])]) UID: _60q30c1g60o30e1i60o4ac1g60rj8gpl88rj2c1h84s34h9g60s30c1g60o30c1g85248hhg6kq30hhn6ork8ghg64o30c1g60o30c1g60o30c1g60o32c1g60o30c1g6kqj4g9g89234chl852kadpk890j2h9m6op44dpn6t238h1k8ks0_R20250129T080000@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2025-06-22 21:59:59 +00:00))), (Some 1), [`Weekday (`Monday); `Byday ([(0, `Monday)])]) UID: 040000008200E00074C5B7101A82E00800000000AE5AF0ED6ADCDB0100000000000000001000000040E4ACABB0843749950BEB4B273F862E
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2026-02-24 22:59:59 +00:00))), (Some 2), [`Weekday (`Monday); `Byday ([(0, `Tuesday)])]) UID: fjlqvi1ekuefpa8rb65meoklct@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2026-03-25 00:00:00 +00:00))), None, [`Weekday (`Monday); `Byday ([(0, `Wednesday)])]) UID: 1iue0uq2l3imtfdsff785o9u35@google.com
|
||||
RRULE: (`Weekly, (Some `Until (`Utc (2026-07-01 09:00:00 +00:00))), None, []) UID: 4479f7fd-7be9-470f-bc10-5ed61636547b
|
||||
*)
|
||||
let simple_recurrence rem ev : (Remind.rem, error) result =
|
||||
match ev.rrule with
|
||||
| Some (_, (`Yearly, None, None, [])) -> Ok rem
|
||||
| Some (_, (freq, count_or_until, interval, recurs)) ->
|
||||
let _recur = (freq, count_or_until, interval, recurs) in
|
||||
let uid = Utils.get_uid ev in
|
||||
Printf.eprintf "RRULE: %s\t\t\tUID: %s\n" (Icalendar.show_recurrence _recur) uid;
|
||||
| Some (_, (`Yearly, None, None, [])) -> Ok rem (* handled in yearly_simple_date *)
|
||||
| Some (_, ((`Weekly as freq), count_or_until, interval, recurs))
|
||||
| Some (_, ((`Daily as freq), count_or_until, interval, recurs)) -> begin
|
||||
let days =
|
||||
ListLabels.filter_map recurs ~f:(function
|
||||
| `Byday days -> begin List.map (fun (_n, weekday) -> weekday) days |> Option.some end
|
||||
| _ -> None)
|
||||
|> List.flatten
|
||||
in
|
||||
let week_start =
|
||||
ListLabels.find_map recurs ~f:(function
|
||||
| `Weekday `Sunday -> Some `Sunday
|
||||
| `Weekday `Monday -> Some `Monday
|
||||
| _ -> None)
|
||||
in
|
||||
match freq with
|
||||
| `Daily -> Ok { rem with Remind.weekly = None; Remind.daily = Some { count_or_until; interval; week_start } }
|
||||
| `Weekly ->
|
||||
let days = if days = [] then [ timedesc_wd_to_ical (Timedesc.Date.weekday rem.date) ] else days in
|
||||
Ok
|
||||
{
|
||||
rem with
|
||||
Remind.daily = None;
|
||||
Remind.weekly = Some { count_or_until; interval; byday = days; week_start };
|
||||
}
|
||||
end
|
||||
| Some (_, (`Monthly, count_or_until, interval, recurs)) ->
|
||||
begin match interval with
|
||||
| Some n when n > 1 ->
|
||||
Utils.warn "Warning: MONTHLY INTERVAL=%d not supported, skipping (UID: %s)\n" n (Utils.get_uid ev);
|
||||
skip
|
||||
| _ -> (
|
||||
let bymonthday =
|
||||
List.find_map
|
||||
(function
|
||||
| `Bymonthday (d :: _) -> Some d
|
||||
| _ -> None)
|
||||
recurs
|
||||
in
|
||||
let byday =
|
||||
List.find_map
|
||||
(function
|
||||
| `Byday pairs -> List.find_map (fun (n, wd) -> if n <> 0 then Some (n, wd) else None) pairs
|
||||
| _ -> None)
|
||||
recurs
|
||||
in
|
||||
let pattern =
|
||||
match (bymonthday, byday) with
|
||||
| _, Some (n, wd) -> Some (Remind.By_nth_weekday (n, wd)) (* BYDAY takes precedence *)
|
||||
| Some day, None -> Some (Remind.By_month_day day)
|
||||
| None, None -> Some (Remind.By_month_day (Timedesc.Date.day rem.Remind.date))
|
||||
in
|
||||
match pattern with
|
||||
| None ->
|
||||
Utils.warn "Warning: MONTHLY with unsupported BYDAY, skipping (UID: %s)\n" (Utils.get_uid ev);
|
||||
skip
|
||||
| Some p -> Ok { rem with Remind.monthly = Some { count_or_until; interval; pattern = p } })
|
||||
end
|
||||
| Some (_, recurs) ->
|
||||
Utils.warn "Warning: unsupported recurrence rule, skipping (UID: %s)\n" (Utils.get_uid ev);
|
||||
skip
|
||||
(* TODO: implementare *)
|
||||
| None -> Ok rem
|
||||
|
||||
let all_collectors : (collector * event_description) list =
|
||||
let is_cancelled (ev : Icalendar.event) : bool =
|
||||
List.exists
|
||||
(function
|
||||
| `Status (_, `Cancelled) -> true
|
||||
| _ -> false)
|
||||
ev.props
|
||||
|
||||
let build_override_rem (source : string) (override_ev : Icalendar.event) : (Remind.rem, error) result =
|
||||
let rem = { Remind.empty with Remind.source } in
|
||||
let collectors =
|
||||
[
|
||||
collect_uuid;
|
||||
collect_summary;
|
||||
collect_location;
|
||||
collect_description;
|
||||
collect_conference_url;
|
||||
collect_start_end_duration;
|
||||
collect_triggers;
|
||||
]
|
||||
in
|
||||
ListLabels.fold_left ~init:(Ok rem) collectors ~f:(fun rem_or_error pred ->
|
||||
match rem_or_error with
|
||||
| Error e -> Error e
|
||||
| Ok rem -> pred rem override_ev)
|
||||
|
||||
let collect_overrides rem _ev : (Remind.rem, error) result =
|
||||
(* Process each RECURRENCE-ID override event stored in rem.recurring:
|
||||
- add its RECURRENCE-ID date to rem.exdate (feeds the OMIT mechanism)
|
||||
- for non-cancelled overrides, build a single REM and add to rem.overrides *)
|
||||
let new_exdates, new_overrides =
|
||||
ListLabels.fold_left ~init:([], []) rem.Remind.recurring ~f:(fun (exdates, overrides) override_ev ->
|
||||
let recur_id_opt = Utils.get_recurrence_id override_ev in
|
||||
let exdates =
|
||||
match recur_id_opt with
|
||||
| None ->
|
||||
Utils.warn "Warning: override event has no RECURRENCE-ID, skipping (UID: %s)\n"
|
||||
(Utils.get_uid override_ev);
|
||||
exdates
|
||||
| Some date_or_dt -> date_or_dt :: exdates
|
||||
in
|
||||
let overrides =
|
||||
if is_cancelled override_ev then overrides
|
||||
else
|
||||
match build_override_rem rem.Remind.source override_ev with
|
||||
| Error _ ->
|
||||
Utils.warn "Warning: could not build override REM, skipping (UID: %s)\n" (Utils.get_uid override_ev);
|
||||
overrides
|
||||
| Ok override_rem -> override_rem :: overrides
|
||||
in
|
||||
(exdates, overrides))
|
||||
in
|
||||
Ok
|
||||
{
|
||||
rem with
|
||||
Remind.exdate = rem.Remind.exdate @ List.rev new_exdates;
|
||||
Remind.overrides = List.rev new_overrides;
|
||||
Remind.recurring = [];
|
||||
}
|
||||
|
||||
let all_collectors : collector list =
|
||||
[
|
||||
(collect_uuid, `Collect_uuid);
|
||||
(collect_summary, `Has_summary);
|
||||
(collect_start_end_duration, `All_day_event);
|
||||
(expand_recurrence, `Expand_recurrence);
|
||||
(yearly_simple_date, `Yearly_simple_date);
|
||||
(simple_weekly_recurrence, `Simple_weekly_recurrence);
|
||||
collect_uuid;
|
||||
collect_summary;
|
||||
collect_location;
|
||||
collect_description;
|
||||
collect_conference_url;
|
||||
collect_start_end_duration;
|
||||
collect_exdates;
|
||||
collect_triggers;
|
||||
collect_overrides;
|
||||
yearly_simple_date;
|
||||
simple_recurrence;
|
||||
]
|
||||
|
||||
let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result =
|
||||
let remind_of_event (source : string) (ev : Icalendar.event list) : (Remind.rem, error) result =
|
||||
let () = if List.length ev = 0 then failwith "No events provided" in
|
||||
|
||||
let master, recurrence =
|
||||
@@ -341,9 +274,9 @@ let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result =
|
||||
end
|
||||
in
|
||||
|
||||
let rem = { Remind.empty with Remind.recurring = recurrence } in
|
||||
let rem = { Remind.empty with Remind.source; Remind.original_event = Some master; Remind.recurring = recurrence } in
|
||||
|
||||
ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error (pred, _desc) ->
|
||||
ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error pred ->
|
||||
match rem_or_error with
|
||||
| Error e -> Error e
|
||||
| Ok rem -> pred rem master)
|
||||
|
||||
131
bin/main.ml
131
bin/main.ml
@@ -1,4 +1,3 @@
|
||||
open Remind_sync
|
||||
module Map = MoreLabels.Map.Make (String)
|
||||
|
||||
(*
|
||||
@@ -7,38 +6,110 @@ module Map = MoreLabels.Map.Make (String)
|
||||
(e.g., due to updates or recurring events or cancellations).
|
||||
*)
|
||||
|
||||
let ical2rem ical_file =
|
||||
let ic = open_in ical_file in
|
||||
let read_file filename =
|
||||
let ic = open_in filename in
|
||||
let n = in_channel_length ic in
|
||||
let s = Bytes.create n in
|
||||
really_input ic s 0 n;
|
||||
close_in ic;
|
||||
let cal_or_error = Icalendar.parse (Bytes.unsafe_to_string s) in
|
||||
match cal_or_error with
|
||||
| Error e ->
|
||||
if e = ": not enough input" then
|
||||
exit 0 (* This is a common error when the file is empty, so we treat it as a non-error case *)
|
||||
else prerr_endline ("Error parsing iCalendar file: " ^ e)
|
||||
| Ok (_, components) -> begin
|
||||
let events_map : Icalendar.event list Map.t =
|
||||
ListLabels.fold_left ~init:Map.empty components ~f:(fun acc comp ->
|
||||
match comp with
|
||||
| `Event ev ->
|
||||
let uid = Utils.get_uid ev in
|
||||
let event_list = Map.find_opt uid acc |> Option.value ~default:[] in
|
||||
Map.add ~key:uid ~data:(ev :: event_list) acc
|
||||
| _ -> acc (* Ignore non-event components *))
|
||||
in
|
||||
(* Now revert all the lists *)
|
||||
let events_map = Map.map ~f:List.rev events_map in
|
||||
(* Printf.printf "Events: %d\n\n" (Map.cardinal events_map); *)
|
||||
Bytes.unsafe_to_string s
|
||||
|
||||
Map.iter events_map ~f:(fun ~key:uid ~data:events ->
|
||||
let rem_or_error = EventPredicates.remind_of_event events in
|
||||
match rem_or_error with
|
||||
| Ok rem -> begin Printf.printf "%s\n" (Remind.string_of_rem rem) end
|
||||
| Error (EventPredicates.Invalid_date s) -> Printf.eprintf "UID: %s Invalid date: %s\n" uid s
|
||||
| Error Skip -> Printf.eprintf "UID: %s Skipped\n" uid)
|
||||
end
|
||||
let read_stdin () =
|
||||
let buf = Buffer.create 4096 in
|
||||
(try
|
||||
while true do
|
||||
Buffer.add_channel buf stdin 4096
|
||||
done
|
||||
with End_of_file -> ());
|
||||
Buffer.contents buf
|
||||
|
||||
let () = if !Sys.interactive then () else exit (CommandLine.main ical2rem)
|
||||
let ical2rem (args : CommandLine.cli_args) ical_files =
|
||||
(* Validate: '-' (stdin) may appear at most once *)
|
||||
let stdin_count = List.length (List.filter (( = ) "-") ical_files) in
|
||||
if stdin_count > 1 then begin
|
||||
Printf.eprintf "Error: '-' (stdin) may appear at most once.\n";
|
||||
exit 1
|
||||
end;
|
||||
(* Validate --source with multiple files *)
|
||||
(match args.source with
|
||||
| Some _ when List.length ical_files > 1 ->
|
||||
Printf.eprintf "Error: --source can only be used with a single input file.\n";
|
||||
exit 1
|
||||
| _ -> ());
|
||||
Config.verbose := args.verbose;
|
||||
Config.no_uuid := args.no_uuid;
|
||||
Config.no_source := args.no_source;
|
||||
Config.no_location := args.no_location;
|
||||
Config.no_description := args.no_description;
|
||||
Config.no_conference_url := args.no_conference_url;
|
||||
Utils.init_target_tz args.tz;
|
||||
let good_rems =
|
||||
ListLabels.fold_left ~init:[] ical_files ~f:(fun good_rems_acc filename ->
|
||||
try
|
||||
let file_content, basename =
|
||||
if filename = "-" then
|
||||
( read_stdin (),
|
||||
match args.source with
|
||||
| Some name -> name
|
||||
| None -> "stdin" )
|
||||
else
|
||||
( read_file filename,
|
||||
match args.source with
|
||||
| Some name -> name
|
||||
| None -> Filename.remove_extension (Filename.basename filename) )
|
||||
in
|
||||
match Icalendar.parse file_content with
|
||||
| Error e ->
|
||||
if e <> ": not enough input" then Utils.warn "Error: could not parse %s: %s\n" filename e;
|
||||
good_rems_acc
|
||||
| Ok (_, components) -> begin
|
||||
let events_map : Icalendar.event list Map.t =
|
||||
ListLabels.fold_left ~init:Map.empty components ~f:(fun acc comp ->
|
||||
match comp with
|
||||
| `Event ev ->
|
||||
let uid = Utils.get_uid ev in
|
||||
let event_list = Map.find_opt uid acc |> Option.value ~default:[] in
|
||||
Map.add ~key:uid ~data:(ev :: event_list) acc
|
||||
| _ -> acc (* Ignore non-event components *))
|
||||
in
|
||||
|
||||
let events_map = Map.map ~f:List.rev events_map in
|
||||
|
||||
let good_rems =
|
||||
Map.fold ~init:[] events_map ~f:(fun ~key:uid ~data:events good_rems ->
|
||||
let rem_or_error = EventPredicates.remind_of_event basename events in
|
||||
match rem_or_error with
|
||||
| Ok rem -> rem :: good_rems
|
||||
| Error (EventPredicates.Invalid_date s) ->
|
||||
Utils.warn "Warning: invalid date: %s (UID: %s)\n" s uid;
|
||||
good_rems
|
||||
| Error Skip ->
|
||||
Utils.warn "Warning: event skipped (UID: %s)\n" uid;
|
||||
good_rems)
|
||||
in
|
||||
let good_rems = List.rev good_rems in
|
||||
good_rems @ good_rems_acc
|
||||
end
|
||||
with e ->
|
||||
Printf.eprintf "Error: could not read file %s: %s\n%s" filename (Printexc.to_string e)
|
||||
(Printexc.get_backtrace ());
|
||||
good_rems_acc)
|
||||
in
|
||||
|
||||
let good_rems =
|
||||
match args.sort with
|
||||
| CommandLine.Desc -> List.sort (fun a b -> Timedesc.Date.compare b.Remind.date a.Remind.date) good_rems
|
||||
| CommandLine.Asc -> List.sort (fun a b -> Timedesc.Date.compare a.Remind.date b.Remind.date) good_rems
|
||||
| CommandLine.Original -> good_rems
|
||||
in
|
||||
try ListLabels.iter good_rems ~f:(fun rem -> Printf.printf "%s" (Remind.string_of_rem rem))
|
||||
with e ->
|
||||
Printf.eprintf "Error processing reminders: %s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ());
|
||||
exit 1
|
||||
|
||||
let () =
|
||||
if !Sys.interactive then ()
|
||||
else begin
|
||||
Printexc.record_backtrace true;
|
||||
exit (CommandLine.main ical2rem)
|
||||
end
|
||||
|
||||
452
bin/remind.ml
452
bin/remind.ml
@@ -1,62 +1,446 @@
|
||||
open Remind_sync
|
||||
open Utils
|
||||
|
||||
type week_first_day = [ `Sunday | `Monday ]
|
||||
|
||||
type simple_weekly = {
|
||||
count_or_until : Icalendar.count_or_until option;
|
||||
interval : int option; (** Optional interval for weekly recurrence, default is 1 *)
|
||||
byday : Icalendar.weekday list;
|
||||
week_start : week_first_day option; (** First day of the week for weekly recurrence *)
|
||||
}
|
||||
(** A simple weekly REM command *)
|
||||
|
||||
type simple_daily = {
|
||||
count_or_until : Icalendar.count_or_until option;
|
||||
interval : int option; (** Optional interval for daily recurrence, default is 1 *)
|
||||
week_start : week_first_day option; (** First day of the week for weekly recurrence *)
|
||||
}
|
||||
(** A simple daily REM command *)
|
||||
|
||||
type monthly_pattern =
|
||||
| By_month_day of int (** P07: BYMONTHDAY=n or implicit day from DTSTART *)
|
||||
| By_nth_weekday of int * Icalendar.weekday (** P08: BYDAY=nWD, n≠0, can be negative *)
|
||||
|
||||
type simple_monthly = {
|
||||
count_or_until : Icalendar.count_or_until option;
|
||||
interval : int option;
|
||||
pattern : monthly_pattern;
|
||||
}
|
||||
(** A simple monthly REM command *)
|
||||
|
||||
type rem = {
|
||||
source : string; (** Source file or identifier for the reminder *)
|
||||
original_uuid : string; (** Original UID from the iCalendar event *)
|
||||
original_event : Icalendar.event option; (** The original iCalendar event *)
|
||||
summary : string; (** Summary or title of the reminder *)
|
||||
location : string option; (** Optional location of the event *)
|
||||
description : string option; (** Optional description of the event *)
|
||||
conference_url : string option; (** Optional conference URL for virtual meetings *)
|
||||
date : Timedesc.Date.t; (** Date specification (day, month, year) *)
|
||||
end_date : Timedesc.Date.t option; (** Optional end date for a date range *)
|
||||
time : Timedesc.Time.t option; (** Optional time specification (hour, minute) *)
|
||||
duration : Timedesc.Span.t option; (** Optional duration for timed events *)
|
||||
simple_yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *)
|
||||
yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *)
|
||||
monthly : simple_monthly option; (** Optional simple monthly recurrence *)
|
||||
weekly : simple_weekly option; (** Optional simple weekly recurrence *)
|
||||
daily : simple_daily option; (** Optional simple daily recurrence *)
|
||||
recurring : Icalendar.event list;
|
||||
(** List of events that are part of the same recurring series: these are only the overrides, not the master event
|
||||
*)
|
||||
exdate : Icalendar.date_or_datetime list; (** List of excluded dates for recurring events *)
|
||||
overrides : rem list; (** Single-event REMs generated from non-cancelled RECURRENCE-ID overrides *)
|
||||
tz : Timedesc.Time_zone.t option; (** Timezone of the event's DTSTART, used for UNTIL conversion *)
|
||||
triggers : Timedesc.Span.t list; (** List of trigger offsets for alarms, in seconds *)
|
||||
}
|
||||
[@@deriving show]
|
||||
(** A complete REM command *)
|
||||
|
||||
let empty =
|
||||
{
|
||||
source = "";
|
||||
original_uuid = "";
|
||||
original_event = None;
|
||||
summary = "";
|
||||
location = None;
|
||||
description = None;
|
||||
conference_url = None;
|
||||
date = Timedesc.Date.Ymd.make_exn ~year:1970 ~month:1 ~day:1;
|
||||
end_date = None;
|
||||
time = None;
|
||||
duration = None;
|
||||
simple_yearly = None;
|
||||
yearly = None;
|
||||
monthly = None;
|
||||
weekly = None;
|
||||
daily = None;
|
||||
recurring = [];
|
||||
exdate = [];
|
||||
overrides = [];
|
||||
tz = None;
|
||||
triggers = [];
|
||||
}
|
||||
|
||||
let render_simple_yearly month day summary =
|
||||
let month_str = month_of_int month |> string_of_month in
|
||||
spf "REM %s %d MSG %s" month_str day summary
|
||||
(* ── alarm rendering ─────────────────────────────────────────── *)
|
||||
|
||||
(** Deterministic alarm function name tag derived from the event UID and date. Using both fields ensures uniqueness
|
||||
across calendars (UUID is globally unique) and between a master event and its date-specific overrides (which share
|
||||
the same UUID). *)
|
||||
let alarm_hash rem =
|
||||
let key = rem.original_uuid ^ Timedesc.Date.to_rfc3339 rem.date in
|
||||
let h = String.fold_left (fun acc c -> ((acc * 1000003) + Char.code c) land 0x3FFFFFFF) 0 key in
|
||||
spf "%08x" h
|
||||
|
||||
(** Convert a Timedesc.Span.t to signed total minutes. Negative = before event; positive = after event. *)
|
||||
let span_to_minutes (sp : Timedesc.Span.t) : int =
|
||||
let v = Timedesc.Span.For_human.view sp in
|
||||
let sign =
|
||||
match v.Timedesc.Span.For_human.sign with
|
||||
| `Pos -> 1
|
||||
| `Neg -> -1
|
||||
in
|
||||
sign * ((v.days * 1440) + (v.hours * 60) + v.minutes)
|
||||
|
||||
(** For timed events: keep only negative triggers, convert to positive minutes-before-event, sort ascending (closest to
|
||||
event first, suitable for SCHED sequence). *)
|
||||
let timed_trigger_minutes (triggers : Timedesc.Span.t list) : int list =
|
||||
triggers
|
||||
|> List.filter_map (fun sp ->
|
||||
let m = span_to_minutes sp in
|
||||
if m >= 0 then None else Some (-m))
|
||||
|> List.sort_uniq compare
|
||||
|
||||
(** For all-day events: keep only negative triggers, convert to days-before-event (ceiling, min 1), deduplicate, sort
|
||||
descending (furthest first, suitable for WARN sequence). *)
|
||||
let allday_trigger_days (triggers : Timedesc.Span.t list) : int list =
|
||||
triggers
|
||||
|> List.filter_map (fun sp ->
|
||||
let m = span_to_minutes sp in
|
||||
if m >= 0 then None
|
||||
else
|
||||
let abs_min = -m in
|
||||
let days = max 1 ((abs_min + 1439) / 1440) in
|
||||
Some days)
|
||||
|> List.sort_uniq compare
|
||||
|> List.rev
|
||||
|
||||
type alarm_rendering = {
|
||||
fset : string; (** FSET line(s) to emit before REM, empty if none *)
|
||||
day_delta : string; (** "++n " or "WARN name " or "" — inserted in trigger spec *)
|
||||
time_delta : string; (** "+n " or "" — appended after AT time (single timed trigger) *)
|
||||
sched : string; (** "SCHED name " or "" — appended after AT clause (multiple timed triggers) *)
|
||||
}
|
||||
|
||||
let empty_alarm = { fset = ""; day_delta = ""; time_delta = ""; sched = "" }
|
||||
|
||||
(** Compute alarm rendering for a rem, depending on whether the event is timed or all-day and whether there are one or
|
||||
multiple triggers. *)
|
||||
let render_alarm (rem : rem) : alarm_rendering =
|
||||
match rem.triggers with
|
||||
| [] -> empty_alarm
|
||||
| triggers ->
|
||||
if rem.time <> None then
|
||||
(* Timed event *)
|
||||
begin match timed_trigger_minutes triggers with
|
||||
| [] -> empty_alarm
|
||||
| [ n ] -> { empty_alarm with time_delta = spf "+%d " n }
|
||||
| mins ->
|
||||
let name = spf "sched_%s" (alarm_hash rem) in
|
||||
(* SCHED sequence: most-advance first (most negative), then 0 to stop.
|
||||
mins is sorted ascending (closest first), so reverse for SCHED order. *)
|
||||
let sched_vals = List.rev_map (fun n -> spf "%d" (-n)) mins @ [ "0" ] in
|
||||
let fset = spf "FSET %s(x) choose(x, %s)\n" name (String.concat ", " sched_vals) in
|
||||
{ empty_alarm with fset; sched = spf "SCHED %s " name }
|
||||
end
|
||||
else
|
||||
(* All-day event *)
|
||||
begin match allday_trigger_days triggers with
|
||||
| [] -> empty_alarm
|
||||
| [ n ] -> { empty_alarm with day_delta = spf "++%d " n }
|
||||
| days ->
|
||||
let name = spf "warn_%s" (alarm_hash rem) in
|
||||
(* WARN sequence: furthest first (days sorted descending), then 0 to stop. *)
|
||||
let warn_vals = List.map string_of_int (days @ [ 0 ]) in
|
||||
let fset = spf "FSET %s(x) choose(x, %s)\n" name (String.concat ", " warn_vals) in
|
||||
{ empty_alarm with fset; day_delta = spf "WARN %s " name }
|
||||
end
|
||||
|
||||
(* ── buffer primitives ────────────────────────────────────────── *)
|
||||
let add_rem b = Buffer.add_string b "REM "
|
||||
let add_uid b uuid = if not !Config.no_uuid then Buffer.add_string b (spf "\\\n INFO \"UID: %s\" " uuid)
|
||||
|
||||
let add_source b source =
|
||||
if not !Config.no_source then
|
||||
Buffer.add_string b (spf "\\\n INFO \"Calendar: %s\" " (String.uppercase_ascii source))
|
||||
|
||||
let add_date b date = Buffer.add_string b (Timedesc.Date.to_rfc3339 date)
|
||||
let add_weekday b wd = Buffer.add_string b (spf "%s " (string_of_weekday wd))
|
||||
|
||||
let add_interval b (w : simple_weekly) =
|
||||
let n = Option.value ~default:1 w.interval in
|
||||
Buffer.add_string b (spf "*%d " (n * 7))
|
||||
|
||||
let add_interval_daily b (d : simple_daily) =
|
||||
let n = Option.value ~default:1 d.interval in
|
||||
Buffer.add_string b (spf "*%d " n)
|
||||
|
||||
(** Adjust an UNTIL date: if the event has a start time and the local time of the UNTIL timestamp is strictly before
|
||||
that start time, the last valid occurrence is on the previous day. *)
|
||||
let until_date_adjusted (until_ts : Timedesc.t) (event_time : Timedesc.Time.t option) : Timedesc.Date.t =
|
||||
let until_date = Timedesc.date until_ts in
|
||||
match event_time with
|
||||
| None -> until_date
|
||||
| Some evt_t ->
|
||||
let until_t = Timedesc.time until_ts in
|
||||
let cmp = Timedesc.Span.compare (Timedesc.Time.to_span until_t) (Timedesc.Time.to_span evt_t) in
|
||||
if cmp < 0 then Timedesc.Date.add ~days:(-1) until_date else until_date
|
||||
|
||||
let add_until b rem (w : simple_weekly) =
|
||||
match w.count_or_until with
|
||||
| None -> ()
|
||||
| Some (`Until d) ->
|
||||
let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in
|
||||
let ts = timedesc_of_utc_or_timestamp_tz tz d in
|
||||
let date = until_date_adjusted ts rem.time in
|
||||
Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 date))
|
||||
| Some (`Count count) ->
|
||||
let wd = Timedesc.Date.weekday rem.date in
|
||||
let wd_int = Timedesc.Utils.tm_int_of_weekday wd in
|
||||
let sub =
|
||||
match w.week_start with
|
||||
| Some `Monday -> wd_int - 1
|
||||
| _ -> wd_int
|
||||
in
|
||||
let iv = Option.value ~default:1 w.interval in
|
||||
let until = Timedesc.Date.add ~days:((count * 7 * iv) - sub) rem.date in
|
||||
Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until))
|
||||
|
||||
let add_until_daily b rem (d : simple_daily) =
|
||||
match d.count_or_until with
|
||||
| None -> ()
|
||||
| Some (`Until dt) ->
|
||||
let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in
|
||||
let ts = timedesc_of_utc_or_timestamp_tz tz dt in
|
||||
let date = until_date_adjusted ts rem.time in
|
||||
Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 date))
|
||||
| Some (`Count count) ->
|
||||
let iv = Option.value ~default:1 d.interval in
|
||||
let until = Timedesc.Date.add ~days:((count - 1) * iv) rem.date in
|
||||
Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until))
|
||||
|
||||
let add_until_monthly b rem (m : simple_monthly) =
|
||||
match m.count_or_until with
|
||||
| None -> ()
|
||||
| Some (`Until dt) ->
|
||||
let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in
|
||||
let ts = timedesc_of_utc_or_timestamp_tz tz dt in
|
||||
let date = until_date_adjusted ts rem.time in
|
||||
Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 date))
|
||||
| Some (`Count count) ->
|
||||
let base = Utils.add_months rem.date (count - 1) in
|
||||
let until =
|
||||
match m.pattern with
|
||||
| By_month_day _ -> base
|
||||
| By_nth_weekday _ -> Timedesc.Date.add ~days:6 base (* weekday can shift up to 6 days *)
|
||||
in
|
||||
Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until))
|
||||
|
||||
let add_at b (alarm : alarm_rendering) = function
|
||||
| Some t -> Buffer.add_string b (spf " AT %s %s%s" (string_of_time t) alarm.time_delta alarm.sched)
|
||||
| None -> ()
|
||||
|
||||
let add_duration b = function
|
||||
| Some d -> Buffer.add_string b (spf " DURATION %s" (string_of_span d))
|
||||
| None -> ()
|
||||
|
||||
let add_through b = function
|
||||
| Some d -> Buffer.add_string b (spf " THROUGH %s" (Timedesc.Date.to_rfc3339 d))
|
||||
| None -> ()
|
||||
|
||||
(** Escape special characters in the body of a MSG clause.
|
||||
- '%' must become '%%' (literal percent)
|
||||
- '[' must become '["["]' (a Remind expression that evaluates to the literal string "[") *)
|
||||
let escape_msg s =
|
||||
let buf = Buffer.create (String.length s) in
|
||||
String.iter
|
||||
(function
|
||||
| '\n' -> Buffer.add_string buf "\\n"
|
||||
| '\t' -> ()
|
||||
| '"' -> Buffer.add_string buf "\\\""
|
||||
| '%' -> Buffer.add_string buf "%%"
|
||||
| '[' -> Buffer.add_string buf {|["["]|}
|
||||
| c -> Buffer.add_char buf c)
|
||||
s;
|
||||
Buffer.contents buf
|
||||
|
||||
let add_msg b ?(alarm = empty_alarm) ?(timed = false) summary =
|
||||
let has_alarm = alarm.day_delta <> "" || alarm.time_delta <> "" || alarm.sched <> "" in
|
||||
let body = escape_msg summary in
|
||||
let body =
|
||||
if has_alarm then if timed then spf "%%\"%s%%\" (%%b %%3)" body else spf "%%\"%s%%\" (%%b)" body else body
|
||||
in
|
||||
Buffer.add_string b (spf " MSG %s\n" body)
|
||||
|
||||
let add_location b loc =
|
||||
if not !Config.no_location then
|
||||
match loc with
|
||||
| Some loc ->
|
||||
let loc = String.trim loc in
|
||||
Buffer.add_string b (spf "\\\n INFO \"Location: %s\" " (escape_msg loc))
|
||||
| None -> ()
|
||||
|
||||
let add_description b desc =
|
||||
if not !Config.no_description then
|
||||
match desc with
|
||||
| Some desc ->
|
||||
let desc = String.trim desc in
|
||||
Buffer.add_string b (spf "\\\n INFO \"Description: %s\" " (escape_msg desc))
|
||||
| None -> ()
|
||||
|
||||
let add_url b url =
|
||||
if not !Config.no_conference_url then
|
||||
match url with
|
||||
| Some url ->
|
||||
let url = String.trim url in
|
||||
Buffer.add_string b (spf "\\\n INFO \"Url: %s\" " (escape_msg url))
|
||||
| None -> ()
|
||||
|
||||
let add_common_part b rem =
|
||||
add_rem b;
|
||||
add_uid b rem.original_uuid;
|
||||
add_source b rem.source;
|
||||
add_location b rem.location;
|
||||
add_description b rem.description;
|
||||
add_url b rem.conference_url;
|
||||
Buffer.add_string b "\\\n "
|
||||
|
||||
let date_of_date_or_datetime (d : Icalendar.date_or_datetime) : Timedesc.Date.t =
|
||||
match d with
|
||||
| `Date (year, month, day) -> Timedesc.Date.Ymd.make_exn ~year ~month ~day
|
||||
| `Datetime ts -> Timedesc.date (timedesc_of_timestamp ts)
|
||||
|
||||
let add_omit b (d : Icalendar.date_or_datetime) =
|
||||
let date = date_of_date_or_datetime d in
|
||||
let day = Timedesc.Date.day date in
|
||||
let month = string_of_month (month_of_int (Timedesc.Date.month date)) in
|
||||
let year = Timedesc.Date.year date in
|
||||
Buffer.add_string b (spf "OMIT %d %s %d\n" day month year)
|
||||
|
||||
let add_omit_context b exdates =
|
||||
if exdates <> [] then begin
|
||||
Buffer.add_string b "PUSH-OMIT-CONTEXT\n";
|
||||
List.iter (add_omit b) exdates
|
||||
end
|
||||
|
||||
let close_omit_context b exdates = if exdates <> [] then Buffer.add_string b "POP-OMIT-CONTEXT\n"
|
||||
let add_skip b exdates = if exdates <> [] then Buffer.add_string b "SKIP "
|
||||
|
||||
(* ── rendering ────────────────────────────────────────────────── *)
|
||||
|
||||
let render_daily rem (d : simple_daily) =
|
||||
let b = Buffer.create 256 in
|
||||
let alarm = render_alarm rem in
|
||||
Buffer.add_string b alarm.fset;
|
||||
add_omit_context b rem.exdate;
|
||||
add_common_part b rem;
|
||||
add_date b rem.date;
|
||||
Buffer.add_char b ' ';
|
||||
add_interval_daily b d;
|
||||
add_until_daily b rem d;
|
||||
Buffer.add_string b alarm.day_delta;
|
||||
add_skip b rem.exdate;
|
||||
add_at b alarm rem.time;
|
||||
add_duration b rem.duration;
|
||||
add_msg b ~alarm ~timed:(rem.time <> None) rem.summary;
|
||||
close_omit_context b rem.exdate;
|
||||
Buffer.contents b
|
||||
|
||||
let render_weekly rem (w : simple_weekly) =
|
||||
let b = Buffer.create 256 in
|
||||
let alarm = render_alarm rem in
|
||||
Buffer.add_string b alarm.fset;
|
||||
add_omit_context b rem.exdate;
|
||||
List.iter
|
||||
(fun wd ->
|
||||
add_common_part b rem;
|
||||
add_weekday b wd;
|
||||
add_date b rem.date;
|
||||
Buffer.add_char b ' ';
|
||||
add_interval b w;
|
||||
add_until b rem w;
|
||||
Buffer.add_string b alarm.day_delta;
|
||||
add_skip b rem.exdate;
|
||||
add_at b alarm rem.time;
|
||||
add_duration b rem.duration;
|
||||
add_msg b ~alarm ~timed:(rem.time <> None) rem.summary)
|
||||
w.byday;
|
||||
close_omit_context b rem.exdate;
|
||||
Buffer.contents b
|
||||
|
||||
let render_monthly rem (m : simple_monthly) =
|
||||
let b = Buffer.create 256 in
|
||||
let alarm = render_alarm rem in
|
||||
Buffer.add_string b alarm.fset;
|
||||
add_omit_context b rem.exdate;
|
||||
add_common_part b rem;
|
||||
(match m.pattern with
|
||||
| By_month_day day -> Buffer.add_string b (spf "%d " day)
|
||||
| By_nth_weekday (n, wd) when n > 0 ->
|
||||
let day = ((n - 1) * 7) + 1 in
|
||||
add_weekday b wd;
|
||||
Buffer.add_string b (spf "%d " day)
|
||||
| By_nth_weekday (n, wd) (* n < 0 *) ->
|
||||
let back = -n * 7 in
|
||||
add_weekday b wd;
|
||||
Buffer.add_string b (spf "1 --%d " back));
|
||||
Buffer.add_string b (spf "FROM %s " (Timedesc.Date.to_rfc3339 rem.date));
|
||||
add_until_monthly b rem m;
|
||||
Buffer.add_string b alarm.day_delta;
|
||||
add_skip b rem.exdate;
|
||||
add_at b alarm rem.time;
|
||||
add_duration b rem.duration;
|
||||
add_msg b ~alarm ~timed:(rem.time <> None) rem.summary;
|
||||
close_omit_context b rem.exdate;
|
||||
Buffer.contents b
|
||||
|
||||
let render_single rem =
|
||||
let b = Buffer.create 256 in
|
||||
let alarm = render_alarm rem in
|
||||
Buffer.add_string b alarm.fset;
|
||||
add_common_part b rem;
|
||||
add_date b rem.date;
|
||||
Buffer.add_char b ' ';
|
||||
Buffer.add_string b alarm.day_delta;
|
||||
add_at b alarm rem.time;
|
||||
add_duration b rem.duration;
|
||||
add_through b rem.end_date;
|
||||
add_msg b ~alarm ~timed:(rem.time <> None) rem.summary;
|
||||
Buffer.contents b
|
||||
|
||||
let render_yearly rem month day =
|
||||
let b = Buffer.create 64 in
|
||||
let alarm = render_alarm rem in
|
||||
Buffer.add_string b alarm.fset;
|
||||
add_common_part b rem;
|
||||
Buffer.add_string b (spf "%s %d " (month_of_int month |> string_of_month) day);
|
||||
Buffer.add_string b alarm.day_delta;
|
||||
add_at b alarm rem.time;
|
||||
add_msg b ~alarm ~timed:(rem.time <> None) rem.summary;
|
||||
Buffer.contents b
|
||||
|
||||
(* ── dispatcher ───────────────────────────────────────────────── *)
|
||||
|
||||
let string_of_rem rem =
|
||||
match rem.simple_yearly with
|
||||
| Some (month, day) -> render_simple_yearly month day rem.summary
|
||||
| None -> begin
|
||||
let b = Buffer.create 256 in
|
||||
Buffer.add_string b "REM ";
|
||||
Buffer.add_string b (spf "INFO \"UID: %s\" " rem.original_uuid);
|
||||
Buffer.add_string b (Timedesc.Date.to_rfc3339 rem.date);
|
||||
(match rem.time with
|
||||
| Some time ->
|
||||
Buffer.add_string b " AT ";
|
||||
Buffer.add_string b (string_of_time time)
|
||||
| None -> ());
|
||||
(match rem.duration with
|
||||
| Some duration ->
|
||||
Buffer.add_string b " DURATION ";
|
||||
Buffer.add_string b (string_of_span duration);
|
||||
Buffer.add_string b ""
|
||||
| None -> ());
|
||||
(match rem.end_date with
|
||||
| Some end_date ->
|
||||
Buffer.add_string b " THROUGH ";
|
||||
Buffer.add_string b (Timedesc.Date.to_rfc3339 end_date)
|
||||
| None -> ());
|
||||
Buffer.add_string b " MSG ";
|
||||
Buffer.add_string b rem.summary;
|
||||
Buffer.contents b
|
||||
end
|
||||
let main =
|
||||
match rem.daily with
|
||||
| Some d -> render_daily rem d
|
||||
| None -> (
|
||||
match rem.weekly with
|
||||
| Some w -> render_weekly rem w
|
||||
| None -> (
|
||||
match rem.monthly with
|
||||
| Some m -> render_monthly rem m
|
||||
| None -> (
|
||||
match rem.yearly with
|
||||
| Some (month, day) -> render_yearly rem month day
|
||||
| None -> render_single rem)))
|
||||
in
|
||||
let overrides = List.map render_single rem.overrides in
|
||||
String.concat "" (main :: overrides)
|
||||
|
||||
218
bin/utils.ml
218
bin/utils.ml
@@ -1,8 +1,42 @@
|
||||
open Remind_sync
|
||||
open Icalendar
|
||||
|
||||
(** Target timezone for all timestamp conversions. Defaults to local timezone; overridden by --timezone CLI option
|
||||
before any processing begins. *)
|
||||
let target_tz : Timedesc.Time_zone.t ref = ref Timedesc.Time_zone.utc
|
||||
|
||||
let init_target_tz (tz_opt : string option) : unit =
|
||||
match tz_opt with
|
||||
| None -> target_tz := Timedesc.Time_zone.local_exn ()
|
||||
| Some name -> target_tz := Timedesc.Time_zone.make_exn name
|
||||
|
||||
type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
|
||||
|
||||
let timedesc_wd_to_ical (wd : Timedesc.weekday) : Icalendar.weekday =
|
||||
match wd with
|
||||
| `Mon -> `Monday
|
||||
| `Tue -> `Tuesday
|
||||
| `Wed -> `Wednesday
|
||||
| `Thu -> `Thursday
|
||||
| `Fri -> `Friday
|
||||
| `Sat -> `Saturday
|
||||
| `Sun -> `Sunday
|
||||
|
||||
let show_error (e : Timedesc.Date.Ymd.error) : string =
|
||||
match e with
|
||||
| `Does_not_exist -> "Date does not exist"
|
||||
| `Invalid_year y -> Printf.sprintf "Invalid year: %d" y
|
||||
| `Invalid_month m -> Printf.sprintf "Invalid month: %d" m
|
||||
| `Invalid_day d -> Printf.sprintf "Invalid day: %d" d
|
||||
|
||||
let string_of_weekday = function
|
||||
| `Monday -> "Mon"
|
||||
| `Tuesday -> "Tue"
|
||||
| `Wednesday -> "Wed"
|
||||
| `Thursday -> "Thu"
|
||||
| `Friday -> "Fri"
|
||||
| `Saturday -> "Sat"
|
||||
| `Sunday -> "Sun"
|
||||
|
||||
let month_of_int = function
|
||||
| 1 -> Jan
|
||||
| 2 -> Feb
|
||||
@@ -34,6 +68,9 @@ let string_of_month = function
|
||||
|
||||
let spf = Printf.sprintf
|
||||
|
||||
(** Print a diagnostic message on stderr, but only when --verbose is active. *)
|
||||
let warn fmt = if !Config.verbose then Printf.eprintf fmt else Printf.ifprintf stderr fmt
|
||||
|
||||
let get_uid ev =
|
||||
let _, uid = ev.uid in
|
||||
uid
|
||||
@@ -64,42 +101,47 @@ let string_of_span (sp : Timedesc.Span.t) : string =
|
||||
spf "%02d:%02d" hours minutes
|
||||
|
||||
let timedesc_of_timestamp (ts : timestamp) : Timedesc.t =
|
||||
let local_tz = Timedesc.Time_zone.local_exn () in
|
||||
match ts with
|
||||
| `Local t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:local_tz
|
||||
| `Local t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:!target_tz
|
||||
(* this case is not present in my current dataset… *)
|
||||
| `Utc t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:local_tz
|
||||
| `Utc t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:!target_tz
|
||||
| `With_tzid (ts, (_b, tz_name)) ->
|
||||
(* Qui il timestamp è SCRITTO come se fosse UTC (+00:00) ma in realtà va interpretato con
|
||||
il fuso orario indicato da tz_name. *)
|
||||
let tz = Timedesc.Time_zone.make_exn tz_name in
|
||||
(* The timestamp is stored as if it were UTC but must be interpreted in tz_name.
|
||||
We reconstruct the wall-clock time in tz_name, then convert to target_tz. *)
|
||||
(* Resolve the timezone name: Windows names (e.g. "W. Europe Standard Time") are
|
||||
mapped to IANA via the CLDR table; otherwise the name is used as-is (assumed
|
||||
to already be a valid IANA name). If resolution fails entirely, fall back to
|
||||
target_tz with a warning. *)
|
||||
let tz =
|
||||
let candidate = Option.value ~default:tz_name (Windows_tz.to_iana tz_name) in
|
||||
match Timedesc.Time_zone.make candidate with
|
||||
| Some tz -> tz
|
||||
| None ->
|
||||
warn "Warning: unresolvable timezone %S, falling back to local timezone\n" tz_name;
|
||||
!target_tz
|
||||
in
|
||||
let wrong_ts = Timedesc.Utils.timestamp_of_ptime ts in
|
||||
let date = Timedesc.date (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
|
||||
let year, month, day = (Timedesc.Date.year date, Timedesc.Date.month date, Timedesc.Date.day date) in
|
||||
let time = Timedesc.time_view (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
|
||||
let hour, minute, second = (time.Timedesc.Time.hour, time.Timedesc.Time.minute, time.Timedesc.Time.second) in
|
||||
Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz ()
|
||||
let t_in_named_tz = Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz () in
|
||||
(* Convert from tz_name to target_tz *)
|
||||
Timedesc.of_timestamp_exn ~tz_of_date_time:!target_tz (Timedesc.to_timestamp_single t_in_named_tz)
|
||||
|
||||
let timedesc_of_date_or_datetime (t : date_or_datetime) : Timedesc.t =
|
||||
match t with
|
||||
| `Datetime (`Local _ptime_ts) ->
|
||||
(* this case is not present in my current dataset… *)
|
||||
failwith "Unhandled case: `Local datetime"
|
||||
| `Datetime (`Utc ts) ->
|
||||
Timedesc.Utils.timestamp_of_ptime ts
|
||||
|> Timedesc.of_timestamp_exn ~tz_of_date_time:(Timedesc.Time_zone.local_exn ())
|
||||
| `Datetime (`With_tzid (ts, (_b, tz_name))) ->
|
||||
(* Qui il timestamp è SCRITTO come se fosse UTC (+00:00) ma in realtà va interpretato con
|
||||
il fuso orario indicato da tz_name. *)
|
||||
let tz = Timedesc.Time_zone.make_exn tz_name in
|
||||
let wrong_ts = Timedesc.Utils.timestamp_of_ptime ts in
|
||||
let date = Timedesc.date (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
|
||||
let year, month, day = (Timedesc.Date.year date, Timedesc.Date.month date, Timedesc.Date.day date) in
|
||||
let time = Timedesc.time_view (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
|
||||
let hour, minute, second = (time.Timedesc.Time.hour, time.Timedesc.Time.minute, time.Timedesc.Time.second) in
|
||||
Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz ()
|
||||
| `Date (year, month, day) ->
|
||||
Timedesc.make_exn ~year ~month ~day ~hour:0 ~minute:0 ~second:0 ~tz:(Timedesc.Time_zone.local_exn ()) ()
|
||||
let timedesc_of_utc_or_timestamp_local (ts : utc_or_timestamp_local) : Timedesc.t =
|
||||
match ts with
|
||||
| `Local t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:!target_tz
|
||||
(* this case is not present in my current dataset… *)
|
||||
| `Utc t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:!target_tz
|
||||
|
||||
(** Convert a UTC-or-local timestamp to a Timedesc.t in the given timezone. Use this (instead of
|
||||
[timedesc_of_utc_or_timestamp_local]) when the event has a known TZID, so that UNTIL comparisons are independent of
|
||||
the process locale. *)
|
||||
let timedesc_of_utc_or_timestamp_tz (tz : Timedesc.Time_zone.t) (ts : utc_or_timestamp_local) : Timedesc.t =
|
||||
match ts with
|
||||
| `Local t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:tz
|
||||
| `Utc t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:tz
|
||||
|
||||
let get_exdates ev =
|
||||
let event_props = ev.props in
|
||||
@@ -111,36 +153,79 @@ let get_exdates ev =
|
||||
| _ -> None)
|
||||
event_props
|
||||
in
|
||||
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
|
||||
let added =
|
||||
|
||||
let datetimes, dates =
|
||||
ListLabels.fold_left ~init:([], []) dates_or_datetimes ~f:(fun (acc_datetimes, acc_dates) dates ->
|
||||
match dates with
|
||||
| `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list
|
||||
| `Dates date_list -> List.map (fun date -> `Date date) date_list
|
||||
in
|
||||
added @ acc)
|
||||
|> List.map timedesc_of_date_or_datetime
|
||||
| `Dates date_list -> (acc_datetimes, acc_dates @ date_list)
|
||||
| `Datetimes ts_list -> (acc_datetimes @ ts_list, acc_dates))
|
||||
in
|
||||
|
||||
List.map (fun d -> `Date d) dates @ List.map (fun dt -> `Datetime dt) datetimes
|
||||
|
||||
let get_triggers ev : Timedesc.Span.t list =
|
||||
let alarms = ev.Icalendar.alarms in
|
||||
let triggers =
|
||||
ListLabels.fold_left ~init:[] alarms ~f:(fun acc alarm ->
|
||||
let trigger =
|
||||
match alarm with
|
||||
| `Audio a -> Some a.Icalendar.trigger (* we keep audio triggers *)
|
||||
| `Display d -> Some d.Icalendar.trigger (* we keep display triggers *)
|
||||
| `Email _ -> None (* we ignore email triggers *)
|
||||
| `None _ -> None (* we ignore VAL=NONE triggers *)
|
||||
in
|
||||
match trigger with
|
||||
| Some trigger -> begin
|
||||
let _, trigger_duration_or_datetime = trigger in
|
||||
match trigger_duration_or_datetime with
|
||||
| `Duration dur -> Timedesc.Utils.span_of_ptime_span dur :: acc
|
||||
| `Datetime _ -> acc
|
||||
end
|
||||
| None -> acc)
|
||||
in
|
||||
triggers
|
||||
|
||||
let get_rdates ev =
|
||||
let uid = get_uid ev in
|
||||
let event_props = ev.props in
|
||||
let dates_or_datetimes =
|
||||
let dates_or_datetimes_or_periods =
|
||||
List.filter_map
|
||||
(fun prop ->
|
||||
match prop with
|
||||
| `Rdate (_, dates) -> Some dates
|
||||
| `Rdate (_, x) -> Some x
|
||||
| _ -> None)
|
||||
event_props
|
||||
in
|
||||
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
|
||||
let added =
|
||||
let datetimes, dates, periods =
|
||||
ListLabels.fold_left ~init:([], [], []) dates_or_datetimes_or_periods
|
||||
~f:(fun (acc_datetimes, acc_dates, acc_periods) dates ->
|
||||
match dates with
|
||||
| `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list
|
||||
| `Dates date_list -> List.map (fun date -> `Date date) date_list
|
||||
| `Periods _ ->
|
||||
(* Ignored for now, does not appear in my current dataset *)
|
||||
failwith "Unhandled case: `Periods in RDATE"
|
||||
in
|
||||
added @ acc)
|
||||
|> List.map timedesc_of_date_or_datetime
|
||||
| `Dates date_list -> (acc_datetimes, acc_dates @ date_list, acc_periods)
|
||||
| `Datetimes ts_list -> (acc_datetimes @ ts_list, acc_dates, acc_periods)
|
||||
| `Periods period_list -> (acc_datetimes, acc_dates, acc_periods @ period_list))
|
||||
in
|
||||
|
||||
if List.length dates > 0 then
|
||||
warn "Warning: RDATE with dates (%d entries) not supported, skipping (UID: %s)\n" (List.length dates) uid;
|
||||
if List.length datetimes > 0 then
|
||||
warn "Warning: RDATE with datetimes (%d entries) not supported, skipping (UID: %s)\n" (List.length datetimes) uid;
|
||||
if List.length periods > 0 then
|
||||
warn "Warning: RDATE with periods (%d entries) not supported, skipping (UID: %s)\n" (List.length periods) uid;
|
||||
[]
|
||||
|
||||
let add_months (date : Timedesc.Date.t) (n : int) : Timedesc.Date.t =
|
||||
let year = Timedesc.Date.year date in
|
||||
let month = Timedesc.Date.month date in
|
||||
let day = Timedesc.Date.day date in
|
||||
let total_months = (year * 12) + (month - 1) + n in
|
||||
let new_year = total_months / 12 in
|
||||
let new_month = (total_months mod 12) + 1 in
|
||||
let rec try_day d =
|
||||
match Timedesc.Date.Ymd.make ~year:new_year ~month:new_month ~day:d with
|
||||
| Ok date -> date
|
||||
| Error _ -> try_day (d - 1)
|
||||
in
|
||||
try_day day
|
||||
|
||||
let get_recurrence_id ev =
|
||||
List.find_map
|
||||
@@ -150,18 +235,45 @@ let get_recurrence_id ev =
|
||||
| _ -> None)
|
||||
ev.props
|
||||
|
||||
let separate_master_and_recurrence (events : Icalendar.event list) : Icalendar.event * Icalendar.event list =
|
||||
(* List.iteri (fun i e -> Printf.eprintf "%02d: %s\n" (i + 1) (Icalendar.show_component (`Event e))) events; *)
|
||||
let recur_ids = List.map (fun ev -> (ev, get_recurrence_id ev)) events in
|
||||
let get_location ev =
|
||||
List.find_map
|
||||
(fun prop ->
|
||||
match prop with
|
||||
| `Location (_, loc) -> Some loc
|
||||
| _ -> None)
|
||||
ev.props
|
||||
|
||||
let get_description ev =
|
||||
List.find_map
|
||||
(fun prop ->
|
||||
match prop with
|
||||
| `Description (_, desc) -> Some desc
|
||||
| _ -> None)
|
||||
ev.props
|
||||
|
||||
let get_conference_url ev =
|
||||
List.find_map
|
||||
(fun prop ->
|
||||
match prop with
|
||||
| `Xprop (("", "GOOGLE-CONFERENCE"), _, url) -> Some url
|
||||
| `Xprop (("", "MICROSOFT-SKYPETEAMSMEETINGURL"), _, url) -> Some url
|
||||
| _ -> None)
|
||||
ev.props
|
||||
|
||||
let separate_master_and_recurrence (events : Icalendar.event list) : Icalendar.event * Icalendar.event list =
|
||||
let recur_ids = List.map (fun ev -> (ev, get_recurrence_id ev)) events in
|
||||
let master_and_recurrences =
|
||||
List.partition_map
|
||||
(fun (ev, recur_id_opt) ->
|
||||
match recur_id_opt with
|
||||
| None -> Right ev
|
||||
| Some _ -> Left ev)
|
||||
| None -> Left ev (* no RECURRENCE-ID → master *)
|
||||
| Some _ -> Right ev (* has RECURRENCE-ID → override *))
|
||||
recur_ids
|
||||
in
|
||||
match master_and_recurrences with
|
||||
| [], _ -> failwith "No master event found"
|
||||
| master :: _, recurrences -> (master, recurrences)
|
||||
| [ master ], recurrences -> (master, recurrences)
|
||||
| master :: rest, recurrences ->
|
||||
warn "Warning: %d extra master events (no RECURRENCE-ID), only first used (UID: %s)\n" (List.length rest)
|
||||
(get_uid master);
|
||||
(master, recurrences)
|
||||
|
||||
149
bin/windows_tz.ml
Normal file
149
bin/windows_tz.ml
Normal file
@@ -0,0 +1,149 @@
|
||||
(** Mapping from Windows timezone names to canonical IANA timezone names. Source: Unicode CLDR
|
||||
common/supplemental/windowsZones.xml, territory="001" entries.
|
||||
https://github.com/unicode-org/cldr/blob/main/common/supplemental/windowsZones.xml *)
|
||||
|
||||
let table : (string * string) list =
|
||||
[
|
||||
("AUS Central Standard Time", "Australia/Darwin");
|
||||
("AUS Eastern Standard Time", "Australia/Sydney");
|
||||
("Afghanistan Standard Time", "Asia/Kabul");
|
||||
("Alaskan Standard Time", "America/Anchorage");
|
||||
("Aleutian Standard Time", "America/Adak");
|
||||
("Altai Standard Time", "Asia/Barnaul");
|
||||
("Arab Standard Time", "Asia/Riyadh");
|
||||
("Arabian Standard Time", "Asia/Dubai");
|
||||
("Arabic Standard Time", "Asia/Baghdad");
|
||||
("Argentina Standard Time", "America/Buenos_Aires");
|
||||
("Astrakhan Standard Time", "Europe/Astrakhan");
|
||||
("Atlantic Standard Time", "America/Halifax");
|
||||
("Aus Central W. Standard Time", "Australia/Eucla");
|
||||
("Azerbaijan Standard Time", "Asia/Baku");
|
||||
("Azores Standard Time", "Atlantic/Azores");
|
||||
("Bahia Standard Time", "America/Bahia");
|
||||
("Bangladesh Standard Time", "Asia/Dhaka");
|
||||
("Belarus Standard Time", "Europe/Minsk");
|
||||
("Bougainville Standard Time", "Pacific/Bougainville");
|
||||
("Canada Central Standard Time", "America/Regina");
|
||||
("Cape Verde Standard Time", "Atlantic/Cape_Verde");
|
||||
("Caucasus Standard Time", "Asia/Yerevan");
|
||||
("Cen. Australia Standard Time", "Australia/Adelaide");
|
||||
("Central America Standard Time", "America/Guatemala");
|
||||
("Central Asia Standard Time", "Asia/Bishkek");
|
||||
("Central Brazilian Standard Time", "America/Cuiaba");
|
||||
("Central Europe Standard Time", "Europe/Budapest");
|
||||
("Central European Standard Time", "Europe/Warsaw");
|
||||
("Central Pacific Standard Time", "Pacific/Guadalcanal");
|
||||
("Central Standard Time (Mexico)", "America/Mexico_City");
|
||||
("Central Standard Time", "America/Chicago");
|
||||
("Chatham Islands Standard Time", "Pacific/Chatham");
|
||||
("China Standard Time", "Asia/Shanghai");
|
||||
("Cuba Standard Time", "America/Havana");
|
||||
("Dateline Standard Time", "Etc/GMT+12");
|
||||
("E. Africa Standard Time", "Africa/Nairobi");
|
||||
("E. Australia Standard Time", "Australia/Brisbane");
|
||||
("E. Europe Standard Time", "Europe/Chisinau");
|
||||
("E. South America Standard Time", "America/Sao_Paulo");
|
||||
("Easter Island Standard Time", "Pacific/Easter");
|
||||
("Eastern Standard Time (Mexico)", "America/Cancun");
|
||||
("Eastern Standard Time", "America/New_York");
|
||||
("Egypt Standard Time", "Africa/Cairo");
|
||||
("Ekaterinburg Standard Time", "Asia/Yekaterinburg");
|
||||
("FLE Standard Time", "Europe/Kiev");
|
||||
("Fiji Standard Time", "Pacific/Fiji");
|
||||
("GMT Standard Time", "Europe/London");
|
||||
("GTB Standard Time", "Europe/Bucharest");
|
||||
("Georgian Standard Time", "Asia/Tbilisi");
|
||||
("Greenland Standard Time", "America/Godthab");
|
||||
("Greenwich Standard Time", "Atlantic/Reykjavik");
|
||||
("Haiti Standard Time", "America/Port-au-Prince");
|
||||
("Hawaiian Standard Time", "Pacific/Honolulu");
|
||||
("India Standard Time", "Asia/Calcutta");
|
||||
("Iran Standard Time", "Asia/Tehran");
|
||||
("Israel Standard Time", "Asia/Jerusalem");
|
||||
("Jordan Standard Time", "Asia/Amman");
|
||||
("Kaliningrad Standard Time", "Europe/Kaliningrad");
|
||||
("Korea Standard Time", "Asia/Seoul");
|
||||
("Libya Standard Time", "Africa/Tripoli");
|
||||
("Line Islands Standard Time", "Pacific/Kiritimati");
|
||||
("Lord Howe Standard Time", "Australia/Lord_Howe");
|
||||
("Magadan Standard Time", "Asia/Magadan");
|
||||
("Magallanes Standard Time", "America/Punta_Arenas");
|
||||
("Marquesas Standard Time", "Pacific/Marquesas");
|
||||
("Mauritius Standard Time", "Indian/Mauritius");
|
||||
("Middle East Standard Time", "Asia/Beirut");
|
||||
("Montevideo Standard Time", "America/Montevideo");
|
||||
("Morocco Standard Time", "Africa/Casablanca");
|
||||
("Mountain Standard Time (Mexico)", "America/Mazatlan");
|
||||
("Mountain Standard Time", "America/Denver");
|
||||
("Myanmar Standard Time", "Asia/Rangoon");
|
||||
("N. Central Asia Standard Time", "Asia/Novosibirsk");
|
||||
("Namibia Standard Time", "Africa/Windhoek");
|
||||
("Nepal Standard Time", "Asia/Katmandu");
|
||||
("New Zealand Standard Time", "Pacific/Auckland");
|
||||
("Newfoundland Standard Time", "America/St_Johns");
|
||||
("Norfolk Standard Time", "Pacific/Norfolk");
|
||||
("North Asia East Standard Time", "Asia/Irkutsk");
|
||||
("North Asia Standard Time", "Asia/Krasnoyarsk");
|
||||
("North Korea Standard Time", "Asia/Pyongyang");
|
||||
("Omsk Standard Time", "Asia/Omsk");
|
||||
("Pacific SA Standard Time", "America/Santiago");
|
||||
("Pacific Standard Time (Mexico)", "America/Tijuana");
|
||||
("Pacific Standard Time", "America/Los_Angeles");
|
||||
("Pakistan Standard Time", "Asia/Karachi");
|
||||
("Paraguay Standard Time", "America/Asuncion");
|
||||
("Qyzylorda Standard Time", "Asia/Qyzylorda");
|
||||
("Romance Standard Time", "Europe/Paris");
|
||||
("Russia Time Zone 10", "Asia/Srednekolymsk");
|
||||
("Russia Time Zone 11", "Asia/Kamchatka");
|
||||
("Russia Time Zone 3", "Europe/Samara");
|
||||
("Russian Standard Time", "Europe/Moscow");
|
||||
("SA Eastern Standard Time", "America/Cayenne");
|
||||
("SA Pacific Standard Time", "America/Bogota");
|
||||
("SA Western Standard Time", "America/La_Paz");
|
||||
("SE Asia Standard Time", "Asia/Bangkok");
|
||||
("Saint Pierre Standard Time", "America/Miquelon");
|
||||
("Sakhalin Standard Time", "Asia/Sakhalin");
|
||||
("Samoa Standard Time", "Pacific/Apia");
|
||||
("Sao Tome Standard Time", "Africa/Sao_Tome");
|
||||
("Saratov Standard Time", "Europe/Saratov");
|
||||
("Singapore Standard Time", "Asia/Singapore");
|
||||
("South Africa Standard Time", "Africa/Johannesburg");
|
||||
("South Sudan Standard Time", "Africa/Juba");
|
||||
("Sri Lanka Standard Time", "Asia/Colombo");
|
||||
("Sudan Standard Time", "Africa/Khartoum");
|
||||
("Syria Standard Time", "Asia/Damascus");
|
||||
("Taipei Standard Time", "Asia/Taipei");
|
||||
("Tasmania Standard Time", "Australia/Hobart");
|
||||
("Tocantins Standard Time", "America/Araguaina");
|
||||
("Tokyo Standard Time", "Asia/Tokyo");
|
||||
("Tomsk Standard Time", "Asia/Tomsk");
|
||||
("Tonga Standard Time", "Pacific/Tongatapu");
|
||||
("Transbaikal Standard Time", "Asia/Chita");
|
||||
("Turkey Standard Time", "Europe/Istanbul");
|
||||
("Turks And Caicos Standard Time", "America/Grand_Turk");
|
||||
("US Eastern Standard Time", "America/Indianapolis");
|
||||
("US Mountain Standard Time", "America/Phoenix");
|
||||
("UTC", "Etc/UTC");
|
||||
("UTC+12", "Etc/GMT-12");
|
||||
("UTC+13", "Etc/GMT-13");
|
||||
("UTC-02", "Etc/GMT+2");
|
||||
("UTC-08", "Etc/GMT+8");
|
||||
("UTC-09", "Etc/GMT+9");
|
||||
("UTC-11", "Etc/GMT+11");
|
||||
("Ulaanbaatar Standard Time", "Asia/Ulaanbaatar");
|
||||
("Venezuela Standard Time", "America/Caracas");
|
||||
("Vladivostok Standard Time", "Asia/Vladivostok");
|
||||
("Volgograd Standard Time", "Europe/Volgograd");
|
||||
("W. Australia Standard Time", "Australia/Perth");
|
||||
("W. Central Africa Standard Time", "Africa/Lagos");
|
||||
("W. Europe Standard Time", "Europe/Berlin");
|
||||
("W. Mongolia Standard Time", "Asia/Hovd");
|
||||
("West Asia Standard Time", "Asia/Tashkent");
|
||||
("West Bank Standard Time", "Asia/Hebron");
|
||||
("West Pacific Standard Time", "Pacific/Port_Moresby");
|
||||
("Yakutsk Standard Time", "Asia/Yakutsk");
|
||||
("Yukon Standard Time", "America/Whitehorse");
|
||||
]
|
||||
|
||||
(** Look up a Windows timezone name and return the canonical IANA name, if known. *)
|
||||
let to_iana (windows_name : string) : string option = List.assoc_opt windows_name table
|
||||
File diff suppressed because it is too large
Load Diff
49
dune-project
49
dune-project
@@ -1,24 +1,53 @@
|
||||
(lang dune 3.20)
|
||||
(lang dune 3.23)
|
||||
|
||||
(name remind_sync)
|
||||
(name ical2rem)
|
||||
|
||||
(generate_opam_files true)
|
||||
|
||||
(source
|
||||
(uri https://git.donadeo.net/pdonadeo/remind-sync))
|
||||
(uri https://git.donadeo.net/pdonadeo/ical2rem))
|
||||
|
||||
(authors "Paolo Donadeo <paolo@donadeo.net>")
|
||||
|
||||
(maintainers "Maintainer Name <maintainer@example.com>")
|
||||
(maintainers "Paolo Donadeo <paolo@donadeo.net>")
|
||||
|
||||
(license MIT)
|
||||
|
||||
(documentation https://git.donadeo.net/pdonadeo/remind-sync)
|
||||
(documentation https://git.donadeo.net/pdonadeo/ical2rem)
|
||||
|
||||
(package
|
||||
(name remind_sync)
|
||||
(synopsis "A short synopsis")
|
||||
(description "A longer description")
|
||||
(depends ocaml)
|
||||
(name ical2rem)
|
||||
(synopsis "Convert iCalendar (.ics) files to Remind (.rem) format")
|
||||
(description
|
||||
"ical2rem reads iCalendar (.ics) files and produces reminders in the Remind format. It handles recurring events, exceptions (EXDATE/RECURRENCE-ID), alarms (VALARM), timezones, and Windows timezone names.")
|
||||
(depends
|
||||
(ocaml
|
||||
(= 5.4.1))
|
||||
(timedesc
|
||||
(= 3.1.0))
|
||||
(timedesc-tzdb
|
||||
(= 3.1.0))
|
||||
(timedesc-tzlocal
|
||||
(= 3.1.0))
|
||||
(ppx_deriving
|
||||
(= 6.1.1))
|
||||
(cmdliner
|
||||
(= 2.1.1))
|
||||
(icalendar
|
||||
(= 0.1.13))
|
||||
(dune-build-info
|
||||
(>= 3))
|
||||
(dune
|
||||
(and
|
||||
:dev
|
||||
(= 3.23.1)))
|
||||
(ocamlformat
|
||||
(and
|
||||
:dev
|
||||
(= 0.29.0)))
|
||||
(ocaml-lsp-server
|
||||
(and
|
||||
:dev
|
||||
(= 1.26.0))))
|
||||
(tags
|
||||
("add topics" "to describe" your project)))
|
||||
(icalendar remind calendar ics rem converter)))
|
||||
|
||||
40
ical2rem.opam
Normal file
40
ical2rem.opam
Normal file
@@ -0,0 +1,40 @@
|
||||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
synopsis: "Convert iCalendar (.ics) files to Remind (.rem) format"
|
||||
description:
|
||||
"ical2rem reads iCalendar (.ics) files and produces reminders in the Remind format. It handles recurring events, exceptions (EXDATE/RECURRENCE-ID), alarms (VALARM), timezones, and Windows timezone names."
|
||||
maintainer: ["Paolo Donadeo <paolo@donadeo.net>"]
|
||||
authors: ["Paolo Donadeo <paolo@donadeo.net>"]
|
||||
license: "MIT"
|
||||
tags: ["icalendar" "remind" "calendar" "ics" "rem" "converter"]
|
||||
doc: "https://git.donadeo.net/pdonadeo/ical2rem"
|
||||
depends: [
|
||||
"ocaml" {= "5.4.1"}
|
||||
"timedesc" {= "3.1.0"}
|
||||
"timedesc-tzdb" {= "3.1.0"}
|
||||
"timedesc-tzlocal" {= "3.1.0"}
|
||||
"ppx_deriving" {= "6.1.1"}
|
||||
"cmdliner" {= "2.1.1"}
|
||||
"icalendar" {= "0.1.13"}
|
||||
"dune-build-info" {>= "3"}
|
||||
"dune" {>= "3.23" & dev & = "3.23.1"}
|
||||
"ocamlformat" {dev & = "0.29.0"}
|
||||
"ocaml-lsp-server" {dev & = "1.26.0"}
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
build: [
|
||||
["dune" "subst"] {dev}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "https://git.donadeo.net/pdonadeo/ical2rem"
|
||||
x-maintenance-intent: ["(latest)"]
|
||||
8
lib/dune
8
lib/dune
@@ -1,8 +0,0 @@
|
||||
(library
|
||||
(name remind_sync)
|
||||
(modules remind_sync timedesc_augmented result_augmented utf8 icalendar_augmented ptime_augmented)
|
||||
(preprocess
|
||||
(pps ppx_deriving.show))
|
||||
(libraries base logs timedesc uuseg uutf icalendar ptime))
|
||||
|
||||
|
||||
@@ -1,316 +0,0 @@
|
||||
module Params = struct
|
||||
include Icalendar.Params
|
||||
|
||||
let pp ppf _m = Format.pp_print_string ppf "<params>"
|
||||
end
|
||||
|
||||
type params = Params.t [@@deriving show]
|
||||
|
||||
module Ptime = struct
|
||||
include Ptime_augmented
|
||||
end
|
||||
|
||||
(* TODO: tag these with `Utc | `Local *)
|
||||
type timestamp_utc = Ptime.t [@@deriving show]
|
||||
type timestamp_local = Ptime.t [@@deriving show]
|
||||
type utc_or_timestamp_local = [ `Utc of timestamp_utc | `Local of timestamp_local ] [@@deriving show]
|
||||
type timestamp = [ utc_or_timestamp_local | `With_tzid of timestamp_local * (bool * string) ] [@@deriving show]
|
||||
type date_or_datetime = [ `Datetime of timestamp | `Date of Ptime.date ] [@@deriving show]
|
||||
type weekday = [ `Friday | `Monday | `Saturday | `Sunday | `Thursday | `Tuesday | `Wednesday ] [@@deriving show]
|
||||
|
||||
type recur =
|
||||
[ `Byminute of int list
|
||||
| `Byday of (int * weekday) list
|
||||
| `Byhour of int list
|
||||
| `Bymonth of int list
|
||||
| `Bymonthday of int list
|
||||
| `Bysecond of int list
|
||||
| `Bysetposday of int list
|
||||
| `Byweek of int list
|
||||
| `Byyearday of int list
|
||||
| `Weekday of weekday ]
|
||||
[@@deriving show]
|
||||
|
||||
type freq = [ `Daily | `Hourly | `Minutely | `Monthly | `Secondly | `Weekly | `Yearly ] [@@deriving show]
|
||||
type count_or_until = [ `Count of int | `Until of utc_or_timestamp_local (* TODO date or datetime *) ] [@@deriving show]
|
||||
type interval = int [@@deriving show]
|
||||
type recurrence = freq * count_or_until option * interval option * recur list [@@deriving show]
|
||||
|
||||
type valuetype =
|
||||
[ `Binary
|
||||
| `Boolean
|
||||
| `Caladdress
|
||||
| `Date
|
||||
| `Datetime
|
||||
| `Duration
|
||||
| `Float
|
||||
| `Integer
|
||||
| `Period
|
||||
| `Recur
|
||||
| `Text
|
||||
| `Time
|
||||
| `Uri
|
||||
| `Utcoffset
|
||||
| `Xname of string * string
|
||||
| `Ianatoken of string ]
|
||||
|
||||
type cutype = [ `Group | `Individual | `Resource | `Room | `Unknown | `Ianatoken of string | `Xname of string * string ]
|
||||
[@@deriving show]
|
||||
|
||||
type partstat =
|
||||
[ `Accepted
|
||||
| `Completed
|
||||
| `Declined
|
||||
| `Delegated
|
||||
| `In_process
|
||||
| `Needs_action
|
||||
| `Tentative
|
||||
| `Ianatoken of string
|
||||
| `Xname of string * string ]
|
||||
[@@deriving show]
|
||||
|
||||
type role =
|
||||
[ `Chair | `Nonparticipant | `Optparticipant | `Reqparticipant | `Ianatoken of string | `Xname of string * string ]
|
||||
[@@deriving show]
|
||||
|
||||
type relationship = [ `Parent | `Child | `Sibling | `Ianatoken of string | `Xname of string * string ] [@@deriving show]
|
||||
|
||||
type fbtype = [ `Free | `Busy | `Busy_Unavailable | `Busy_Tentative | `Ianatoken of string | `Xname of string * string ]
|
||||
[@@deriving show]
|
||||
|
||||
type param_value = [ `Quoted of string | `String of string ] [@@deriving show]
|
||||
|
||||
type _ icalparameter =
|
||||
| Altrep : Uri.t icalparameter
|
||||
| Cn : param_value icalparameter
|
||||
| Cutype : cutype icalparameter
|
||||
| Delegated_from : Uri.t list icalparameter
|
||||
| Delegated_to : Uri.t list icalparameter
|
||||
| Dir : Uri.t icalparameter
|
||||
| Encoding : [ `Base64 ] icalparameter
|
||||
| Media_type : (string * string) icalparameter
|
||||
| Fbtype : fbtype icalparameter
|
||||
| Language : string icalparameter
|
||||
| Member : Uri.t list icalparameter
|
||||
| Partstat : partstat icalparameter
|
||||
| Range : [ `Thisandfuture ] icalparameter
|
||||
| Related : [ `Start | `End ] icalparameter
|
||||
| Reltype : relationship icalparameter
|
||||
| Role : role icalparameter
|
||||
| Rsvp : bool icalparameter
|
||||
| Sentby : Uri.t icalparameter
|
||||
| Tzid : (bool * string) icalparameter
|
||||
| Valuetype : valuetype icalparameter
|
||||
| Iana_param : string -> param_value list icalparameter
|
||||
| Xparam : (string * string) -> param_value list icalparameter
|
||||
[@@deriving show]
|
||||
|
||||
type other_prop = [ `Iana_prop of string * params * string | `Xprop of (string * string) * params * string ]
|
||||
[@@deriving show]
|
||||
|
||||
type cal_prop =
|
||||
[ `Prodid of params * string
|
||||
| `Version of params * string
|
||||
| `Calscale of params * string
|
||||
| `Method of params * string
|
||||
| other_prop ]
|
||||
[@@deriving show]
|
||||
|
||||
type class_ = [ `Public | `Private | `Confidential | `Ianatoken of string | `Xname of string * string ]
|
||||
[@@deriving show]
|
||||
|
||||
type status =
|
||||
[ `Draft
|
||||
| `Final
|
||||
| `Cancelled
|
||||
| `Needs_action
|
||||
| `Completed
|
||||
| `In_process
|
||||
| (* `Cancelled *)
|
||||
`Tentative
|
||||
| `Confirmed (* | `Cancelled *) ]
|
||||
[@@deriving show]
|
||||
|
||||
type period = timestamp * Ptime.Span.t * bool [@@deriving show]
|
||||
type period_utc = timestamp_utc * Ptime.Span.t * bool [@@deriving show]
|
||||
type dates_or_datetimes = [ `Datetimes of timestamp list | `Dates of Ptime.date list ] [@@deriving show]
|
||||
type dates_or_datetimes_or_periods = [ dates_or_datetimes | `Periods of period list ] [@@deriving show]
|
||||
|
||||
type general_prop =
|
||||
[ `Dtstamp of params * timestamp_utc
|
||||
| `Uid of params * string
|
||||
| `Dtstart of params * date_or_datetime
|
||||
| `Class of params * class_
|
||||
| `Created of params * timestamp_utc
|
||||
| `Description of params * string
|
||||
| `Geo of params * (float * float)
|
||||
| `Lastmod of params * timestamp_utc
|
||||
| `Location of params * string
|
||||
| `Organizer of params * Uri.t
|
||||
| `Priority of params * int
|
||||
| `Seq of params * int
|
||||
| `Status of params * status
|
||||
| `Summary of params * string
|
||||
| `Url of params * Uri.t
|
||||
| `Recur_id of params * date_or_datetime
|
||||
| (* TODO: Furthermore, this property MUST be specified
|
||||
as a date with local time if and only if the "DTSTART" property
|
||||
contained within the recurring component is specified as a date
|
||||
with local time. *)
|
||||
`Rrule of params * recurrence
|
||||
| `Duration of params * Ptime.Span.t
|
||||
| `Attach of params * [ `Uri of Uri.t | `Binary of string ]
|
||||
| `Attendee of params * Uri.t
|
||||
| `Categories of params * string list
|
||||
| `Comment of params * string
|
||||
| `Contact of params * string
|
||||
| `Exdate of params * dates_or_datetimes
|
||||
| `Rstatus of params * ((int * int * int option) * string * string option)
|
||||
| `Related of params * string
|
||||
| `Resource of params * string list
|
||||
| `Rdate of params * dates_or_datetimes_or_periods ]
|
||||
[@@deriving show]
|
||||
|
||||
type event_prop =
|
||||
[ general_prop
|
||||
| `Transparency of params * [ `Transparent | `Opaque ]
|
||||
| `Dtend of params * date_or_datetime
|
||||
| (* TODO: valuetype same as DTSTART *)
|
||||
other_prop ]
|
||||
[@@deriving show]
|
||||
|
||||
type 'a alarm_struct = {
|
||||
trigger : params * [ `Duration of Ptime.Span.t | `Datetime of timestamp_utc ];
|
||||
duration_repeat : ((params * Ptime.Span.t) * (params * int)) option;
|
||||
summary : (params * string) option;
|
||||
other : other_prop list;
|
||||
special : 'a;
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type audio_struct = { attach : (params * [ `Uri of Uri.t | `Binary of string ]) option } [@@deriving show]
|
||||
type display_struct = { description : (params * string) option } [@@deriving show]
|
||||
|
||||
type email_struct = {
|
||||
description : params * string;
|
||||
attendees : (params * Uri.t) list;
|
||||
attach : (params * [ `Uri of Uri.t | `Binary of string ]) option;
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type alarm =
|
||||
[ `Audio of audio_struct alarm_struct
|
||||
| `Display of display_struct alarm_struct
|
||||
| `Email of email_struct alarm_struct
|
||||
| `None of unit alarm_struct ]
|
||||
[@@deriving show]
|
||||
|
||||
type tz_prop =
|
||||
[ `Dtstart_local of params * timestamp_local
|
||||
| `Tzoffset_to of params * Ptime.Span.t
|
||||
| `Tzoffset_from of params * Ptime.Span.t
|
||||
| `Rrule of params * recurrence
|
||||
| `Comment of params * string
|
||||
| `Rdate of params * dates_or_datetimes_or_periods
|
||||
| `Tzname of params * string
|
||||
| other_prop ]
|
||||
[@@deriving show]
|
||||
|
||||
type timezone_prop =
|
||||
[ `Timezone_id of params * (bool * string)
|
||||
| `Lastmod of params * timestamp_utc
|
||||
| `Tzurl of params * Uri.t
|
||||
| `Standard of tz_prop list
|
||||
| `Daylight of tz_prop list
|
||||
| other_prop ]
|
||||
[@@deriving show]
|
||||
|
||||
type todo_prop =
|
||||
[ general_prop
|
||||
| `Completed of params * timestamp_utc
|
||||
| `Percent of params * int
|
||||
| `Due of params * date_or_datetime
|
||||
| other_prop ]
|
||||
[@@deriving show]
|
||||
|
||||
type journal_prop = [ general_prop | other_prop ] [@@deriving show]
|
||||
|
||||
type freebusy_prop =
|
||||
[ `Dtstamp of params * timestamp_utc
|
||||
| `Uid of params * string
|
||||
| `Contact of params * string
|
||||
| `Dtstart_utc of params * timestamp_utc
|
||||
| `Dtend_utc of params * timestamp_utc
|
||||
| `Organizer of params * Uri.t
|
||||
| `Url of params * Uri.t
|
||||
| `Attendee of params * Uri.t
|
||||
| `Comment of params * string
|
||||
| `Freebusy of params * period_utc list
|
||||
| `Rstatus of params * ((int * int * int option) * string * string option)
|
||||
| other_prop ]
|
||||
[@@deriving show]
|
||||
|
||||
type event = {
|
||||
dtstamp : params * timestamp_utc;
|
||||
uid : params * string;
|
||||
dtstart : params * date_or_datetime; (* NOTE: optional if METHOD present according to RFC 5545 *)
|
||||
dtend_or_duration : [ `Duration of params * Ptime.Span.t | `Dtend of params * date_or_datetime ] option;
|
||||
rrule : (params * recurrence) option; (* NOTE: RFC says SHOULD NOT occur more than once *)
|
||||
props : event_prop list;
|
||||
alarms : alarm list;
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type timezone = timezone_prop list [@@deriving show]
|
||||
|
||||
type component =
|
||||
[ `Event of event
|
||||
| `Todo of todo_prop list * alarm list
|
||||
| `Journal of journal_prop list
|
||||
| `Freebusy of freebusy_prop list
|
||||
| `Timezone of timezone ]
|
||||
[@@deriving show]
|
||||
|
||||
let conv_alarm_struct (f : 'a -> 'b) (s : 'a Icalendar.alarm_struct) : 'b alarm_struct =
|
||||
{
|
||||
trigger = s.trigger;
|
||||
duration_repeat = s.duration_repeat;
|
||||
summary = s.summary;
|
||||
other = s.other;
|
||||
special = f s.special;
|
||||
}
|
||||
|
||||
let conv_audio_struct (s : Icalendar.audio_struct) : audio_struct = { attach = s.attach }
|
||||
let conv_display_struct (s : Icalendar.display_struct) : display_struct = { description = s.description }
|
||||
|
||||
let conv_email_struct (s : Icalendar.email_struct) : email_struct =
|
||||
{ description = s.description; attendees = s.attendees; attach = s.attach }
|
||||
|
||||
let conv_alarm (a : Icalendar.alarm) : alarm =
|
||||
match a with
|
||||
| `Audio s -> `Audio (conv_alarm_struct conv_audio_struct s)
|
||||
| `Display s -> `Display (conv_alarm_struct conv_display_struct s)
|
||||
| `Email s -> `Email (conv_alarm_struct conv_email_struct s)
|
||||
| `None s -> `None (conv_alarm_struct Fun.id s)
|
||||
|
||||
let conv_event (e : Icalendar.event) : event =
|
||||
{
|
||||
dtstamp = e.dtstamp;
|
||||
uid = e.uid;
|
||||
dtstart = e.dtstart;
|
||||
dtend_or_duration = e.dtend_or_duration;
|
||||
rrule = e.rrule;
|
||||
props = e.props;
|
||||
alarms = List.map conv_alarm e.alarms;
|
||||
}
|
||||
|
||||
let conv_component (c : Icalendar.component) : component =
|
||||
match c with
|
||||
| `Event e -> `Event (conv_event e)
|
||||
| `Todo (props, alms) -> `Todo (props, List.map conv_alarm alms)
|
||||
| `Journal props -> `Journal props
|
||||
| `Freebusy props -> `Freebusy props
|
||||
| `Timezone tz -> `Timezone tz
|
||||
|
||||
let parse s =
|
||||
Result.map (fun (cal_props, components) -> (cal_props, List.map conv_component components)) (Icalendar.parse s)
|
||||
@@ -1,3 +0,0 @@
|
||||
include Ptime
|
||||
|
||||
type date = int * int * int [@@deriving show]
|
||||
@@ -1,5 +0,0 @@
|
||||
module Icalendar = Icalendar_augmented
|
||||
module Ptime = Ptime_augmented
|
||||
module Result = Result_augmented
|
||||
module Timedesc = Timedesc_augmented
|
||||
module Utf8 = Utf8
|
||||
@@ -1,42 +0,0 @@
|
||||
module Internal_result = struct
|
||||
type ('a, 'b) t = ('a, 'b) result = Ok of 'a | Error of 'b
|
||||
|
||||
let return x = Ok x
|
||||
let error e = Error e
|
||||
let error_string s = Error (`Error_message s)
|
||||
let bind = Stdlib.Result.bind
|
||||
let ok = Result.ok
|
||||
|
||||
module List = struct
|
||||
let map (xs : 'a list) ~(f : 'a -> ('b, 'c) t) : ('b list, 'c) t =
|
||||
let rec loop ?(acc = []) xs =
|
||||
match xs with
|
||||
| [] -> return (List.rev acc)
|
||||
| hd :: tl -> (
|
||||
match f hd with
|
||||
| Ok x -> loop ~acc:(x :: acc) tl
|
||||
| Error e -> Error e)
|
||||
in
|
||||
loop xs
|
||||
|
||||
let iteri ?(start = 0) (xs : 'a list) ~(f : int -> 'a -> (unit, 'b) t) : (unit, 'b) t =
|
||||
let rec loop ?(idx = start) xs =
|
||||
match xs with
|
||||
| [] -> return ()
|
||||
| hd :: tl -> begin
|
||||
let res = f idx hd in
|
||||
match res with
|
||||
| Ok () -> loop ~idx:(idx + 1) tl
|
||||
| Error e -> Error e
|
||||
end
|
||||
in
|
||||
loop xs
|
||||
end
|
||||
|
||||
module Let_syntax = struct
|
||||
let ( let* ) = Stdlib.Result.bind
|
||||
let ( let+ ) x f = Stdlib.Result.map f x
|
||||
end
|
||||
end
|
||||
|
||||
include Internal_result
|
||||
@@ -1,34 +0,0 @@
|
||||
include Timedesc
|
||||
|
||||
type t = Timedesc.t
|
||||
|
||||
module Time = struct
|
||||
include Timedesc.Time
|
||||
|
||||
let pp = Timedesc.Time.pp_rfc3339 ()
|
||||
end
|
||||
|
||||
module Span = struct
|
||||
include Timedesc.Span
|
||||
end
|
||||
|
||||
module Date = struct
|
||||
include Timedesc.Date
|
||||
|
||||
type t = Timedesc.Date.t
|
||||
|
||||
let pp = Timedesc.Date.pp_rfc3339
|
||||
|
||||
module Ymd = struct
|
||||
include Timedesc.Date.Ymd
|
||||
|
||||
type error = [ `Does_not_exist | `Invalid_year of int | `Invalid_month of int | `Invalid_day of int ]
|
||||
[@@deriving show]
|
||||
end
|
||||
end
|
||||
|
||||
module Timestamp = struct
|
||||
type t = Timedesc.Timestamp.t
|
||||
|
||||
let pp = Timedesc.Timestamp.pp
|
||||
end
|
||||
202
lib/utf8.ml
202
lib/utf8.ml
@@ -1,202 +0,0 @@
|
||||
let length = Uuseg_string.fold_utf_8 `Grapheme_cluster (fun x _ -> x + 1) 0
|
||||
|
||||
let capitalize s =
|
||||
let dec = Uutf.decoder ~encoding:`UTF_8 (`String s) in
|
||||
|
||||
let rec split_loop ?(acc = []) () =
|
||||
match Uutf.decode dec with
|
||||
| `Await -> assert false
|
||||
| `End -> List.rev acc
|
||||
| `Malformed _ignored -> split_loop ~acc ()
|
||||
| `Uchar c -> split_loop ~acc:(c :: acc) ()
|
||||
in
|
||||
|
||||
let buf = Buffer.create 1024 in
|
||||
let enc = Uutf.encoder `UTF_8 (`Buffer buf) in
|
||||
let rec capital_loop ?(last_was_upper = false) xs =
|
||||
match xs with
|
||||
| c :: tl ->
|
||||
let last_was_upper =
|
||||
if Uucp.Alpha.is_alphabetic c
|
||||
then begin
|
||||
let f = if last_was_upper = false then Uucp.Case.Map.to_upper else Uucp.Case.Map.to_lower in
|
||||
match f c with
|
||||
| `Self ->
|
||||
let () = Uutf.encode enc (`Uchar c) |> ignore in
|
||||
true
|
||||
| `Uchars u_lst ->
|
||||
List.iter (fun u -> Uutf.encode enc (`Uchar u) |> ignore) u_lst;
|
||||
true
|
||||
end
|
||||
else
|
||||
let () = Uutf.encode enc (`Uchar c) |> ignore in
|
||||
false
|
||||
in
|
||||
capital_loop ~last_was_upper tl
|
||||
| [] ->
|
||||
let () = Uutf.encode enc `End |> ignore in
|
||||
Buffer.contents buf
|
||||
in
|
||||
split_loop () |> capital_loop
|
||||
|
||||
let lowercase s =
|
||||
let dec = Uutf.decoder ~encoding:`UTF_8 (`String s) in
|
||||
|
||||
let rec split_loop ?(acc = []) () =
|
||||
match Uutf.decode dec with
|
||||
| `Await -> assert false
|
||||
| `End -> List.rev acc
|
||||
| `Malformed _ignored -> split_loop ~acc ()
|
||||
| `Uchar c -> split_loop ~acc:(c :: acc) ()
|
||||
in
|
||||
|
||||
let buf = Buffer.create 1024 in
|
||||
let enc = Uutf.encoder `UTF_8 (`Buffer buf) in
|
||||
let rec to_lower xs =
|
||||
match xs with
|
||||
| c :: tl ->
|
||||
if Uucp.Alpha.is_alphabetic c
|
||||
then begin
|
||||
match Uucp.Case.Map.to_lower c with
|
||||
| `Self ->
|
||||
let () = Uutf.encode enc (`Uchar c) |> ignore in
|
||||
to_lower tl
|
||||
| `Uchars u_lst ->
|
||||
List.iter (fun u -> Uutf.encode enc (`Uchar u) |> ignore) u_lst;
|
||||
to_lower tl
|
||||
end
|
||||
else
|
||||
let () = Uutf.encode enc (`Uchar c) |> ignore in
|
||||
to_lower tl
|
||||
| [] ->
|
||||
let () = Uutf.encode enc `End |> ignore in
|
||||
Buffer.contents buf
|
||||
in
|
||||
split_loop () |> to_lower
|
||||
|
||||
let remove_non_alphabetic s =
|
||||
let dec = Uutf.decoder ~encoding:`UTF_8 (`String s) in
|
||||
|
||||
let rec split_loop ?(acc = []) () =
|
||||
match Uutf.decode dec with
|
||||
| `Await -> assert false
|
||||
| `End -> List.rev acc
|
||||
| `Malformed _ignored -> split_loop ~acc ()
|
||||
| `Uchar c -> split_loop ~acc:(c :: acc) ()
|
||||
in
|
||||
|
||||
let buf = Buffer.create 1024 in
|
||||
let enc = Uutf.encoder `UTF_8 (`Buffer buf) in
|
||||
let rec filter_loop xs =
|
||||
match xs with
|
||||
| c :: tl ->
|
||||
if Uucp.Alpha.is_alphabetic c
|
||||
then begin
|
||||
let () = Uutf.encode enc (`Uchar c) |> ignore in
|
||||
filter_loop tl
|
||||
end
|
||||
else filter_loop tl
|
||||
| [] ->
|
||||
let () = Uutf.encode enc `End |> ignore in
|
||||
Buffer.contents buf
|
||||
in
|
||||
split_loop () |> filter_loop
|
||||
|
||||
let split_in_chunks_of n s =
|
||||
let last, chunks =
|
||||
Uuseg_string.fold_utf_8
|
||||
`Grapheme_cluster
|
||||
(fun (last, chunks) grapheme ->
|
||||
let l = List.length last in
|
||||
if l < n
|
||||
then (grapheme :: last, chunks)
|
||||
else if l = n
|
||||
then ([grapheme], (List.rev last |> StringLabels.concat ~sep:"") :: chunks)
|
||||
else assert false)
|
||||
([], [])
|
||||
s
|
||||
in
|
||||
(List.rev last |> StringLabels.concat ~sep:"") :: chunks |> List.rev
|
||||
|
||||
let utf8_clamp_at n s =
|
||||
let first =
|
||||
Uuseg_string.fold_utf_8
|
||||
`Grapheme_cluster
|
||||
(fun acc grapheme -> if List.length acc < n then grapheme :: acc else acc)
|
||||
[]
|
||||
s
|
||||
in
|
||||
let first = String.concat "" (List.rev first) in
|
||||
let l = String.length first in
|
||||
let rest = String.sub s l (String.length s - l) in
|
||||
(first, rest)
|
||||
|
||||
let clamp_at_space_up_to n s =
|
||||
let module S = StringLabels in
|
||||
let module L = ListLabels in
|
||||
let words = S.split_on_char ~sep:' ' s |> L.map ~f:S.trim |> L.filter ~f:(( <> ) "") in
|
||||
|
||||
let words =
|
||||
match words with
|
||||
| first :: rest ->
|
||||
let l_fst = length first in
|
||||
if l_fst <= n
|
||||
then first :: rest
|
||||
else
|
||||
(* Prima parola troppo lunga, forza lo split anche se non è sullo spazio *)
|
||||
let fst, snd = utf8_clamp_at n first in
|
||||
fst :: snd :: rest
|
||||
| [] -> []
|
||||
in
|
||||
|
||||
let rec loop acc words =
|
||||
match words with
|
||||
| hd :: tl ->
|
||||
let l = length hd in
|
||||
if l <= n
|
||||
then loop (hd :: acc) tl
|
||||
else
|
||||
let words' = split_in_chunks_of n hd in
|
||||
loop (L.rev words' @ acc) tl
|
||||
| [] -> L.rev acc
|
||||
in
|
||||
let words = loop [] words in
|
||||
|
||||
let rec loop ?(ok = []) ?(total_chars = 0) ?(total_words = 0) words =
|
||||
match words with
|
||||
| hd :: tl ->
|
||||
let l = length hd in
|
||||
if total_chars + total_words + l > n
|
||||
then (L.rev ok |> S.concat ~sep:" ", S.concat ~sep:" " words)
|
||||
else loop ~ok:(hd :: ok) ~total_chars:(total_chars + l) ~total_words:(total_words + 1) tl
|
||||
| [] -> (L.rev ok |> S.concat ~sep:" ", "")
|
||||
in
|
||||
loop words
|
||||
|
||||
let split_at_space_up_to n s =
|
||||
let rec loop ?(acc = []) s =
|
||||
let s', rest = clamp_at_space_up_to n s in
|
||||
let acc = s' :: acc in
|
||||
if rest = "" then List.rev acc else loop ~acc rest
|
||||
in
|
||||
loop s
|
||||
|
||||
let recode_string ?(encoding = `UTF_8) src =
|
||||
let dst = Buffer.create 4 in
|
||||
let rec loop d e =
|
||||
match Uutf.decode d with
|
||||
| `Uchar _ as u ->
|
||||
let (_ : [`Ok | `Partial]) = Uutf.encode e u in
|
||||
loop d e
|
||||
| `End ->
|
||||
let (_ : [`Ok | `Partial]) = Uutf.encode e `End in
|
||||
()
|
||||
| `Malformed _ ->
|
||||
let (_ : [`Ok | `Partial]) = Uutf.encode e (`Uchar Uutf.u_rep) in
|
||||
loop d e
|
||||
| `Await -> assert false
|
||||
in
|
||||
let d = Uutf.decoder ~nln:(`NLF (Uchar.of_int 10)) ~encoding (`String src) in
|
||||
let e = Uutf.encoder `UTF_8 (`Buffer dst) in
|
||||
let () = loop d e in
|
||||
Buffer.contents dst
|
||||
@@ -1,30 +0,0 @@
|
||||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
synopsis: "A short synopsis"
|
||||
description: "A longer description"
|
||||
maintainer: ["Maintainer Name <maintainer@example.com>"]
|
||||
authors: ["Paolo Donadeo <paolo@donadeo.net>"]
|
||||
license: "MIT"
|
||||
tags: ["add topics" "to describe" "your" "project"]
|
||||
doc: "https://git.donadeo.net/pdonadeo/remind-sync"
|
||||
depends: [
|
||||
"dune" {>= "3.20"}
|
||||
"ocaml"
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
build: [
|
||||
["dune" "subst"] {dev}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "https://git.donadeo.net/pdonadeo/remind-sync"
|
||||
x-maintenance-intent: ["(latest)"]
|
||||
Reference in New Issue
Block a user