pdonadeo/ical2rem
1
0
Fork 0
Code Issues Pull Requests Actions Projects Releases 1 Activity

Initial commit

Browse Source
This commit is contained in:
Paolo Donadeo
2025-09-01 00:00:00 +02:00
commit cace23d3f1
21 changed files with 6678 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
.gitignore vendored Normal file
View File

@@ -0,0 +1,31 @@
# ---> OCaml
*.annot
*.cmo
*.cma
*.cmi
*.a
*.o
*.cmx
*.cmxs
*.cmxa
# ocamlbuild working directory
_build/
# ocamlbuild targets
*.byte
*.native
# oasis generated files
setup.data
setup.log
# Merlin configuring file for Vim and Emacs
.merlin
# Dune generated files
*.install
# Local OPAM switch
_opam/

7
.ocamlformat Normal file
View File

@@ -0,0 +1,7 @@
profile = default
version = 0.29.0
margin = 120
break-cases = fit-or-vertical
break-infix = fit-or-vertical
exp-grouping = preserve

18
LICENSE Normal file
View File

@@ -0,0 +1,18 @@
MIT License
Copyright (c) 2025 pdonadeo
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and
associated documentation files (the "Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the
following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial
portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT
LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO
EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
USE OR OTHER DEALINGS IN THE SOFTWARE.

3
README.md Normal file
View File

@@ -0,0 +1,3 @@
# remind-sync
Simple program to convert iCalendar files into remind format

17
bin/commandLine.ml Normal file
View File

@@ -0,0 +1,17 @@
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 main_command f =
let doc = "Convert iCalendar files to remind format" in
let man = [] in
Cmd.make (Cmd.info "ical2rem" ~version:"%%VERSION%%" ~doc ~man)
@@
let+ ical_file = ical_file in
f ical_file
let main f = Cmd.eval @@ main_command f

13
bin/dune Normal file
View File

@@ -0,0 +1,13 @@
(executable
(public_name remind_sync)
(name main)
(modules main commandLine remind eventPredicates utils)
(preprocess
(pps ppx_deriving.show))
(libraries
remind_sync
cmdliner
icalendar
timedesc-tzdb.full
timedesc-tzlocal.unix
timedesc))

349
bin/eventPredicates.ml Normal file
View File

@@ -0,0 +1,349 @@
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)))
let skip = Error Skip
type collector = Remind.rem -> event -> (Remind.rem, error) result
let collect_uuid rem ev : (Remind.rem, error) result =
let uid = Utils.get_uid ev in
Ok { rem with Remind.original_uuid = uid }
let collect_summary rem ev : (Remind.rem, error) result =
let summary_opt =
List.find_map
(function
| `Summary (_, s) -> Some s
| _ -> None)
ev.props
in
match summary_opt with
| Some s -> Ok { rem with Remind.summary = s }
| None -> Ok { rem with Remind.summary = "" }
let collect_start_end_duration rem ev : (Remind.rem, error) result =
let _, dtstart = ev.dtstart in
match dtstart with
| `Date (year, month, day) -> (
match Timedesc.Date.Ymd.make ~year ~month ~day with
| Error e -> invalid_date "DTSTART" e
| 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 (_, `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
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
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
match ev.dtend_or_duration with
| None -> Ok rem
| Some (`Dtend (_, date_or_datetime)) ->
begin match date_or_datetime with
| `Datetime datetime -> begin
let end_td = Utils.timedesc_of_timestamp datetime in
let duration =
Timedesc.Span.sub (Timedesc.to_timestamp_single end_td) (Timedesc.to_timestamp_single start_td)
in
let rem = { rem with Remind.duration = Some duration } in
Ok rem
end
| `Date (_year, _month, _day) -> skip
end
| Some (`Duration (_, duration)) ->
let span = Timedesc.Utils.span_of_ptime_span duration in
let rem = { rem with Remind.duration = Some span } in
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 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) }
| 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
*)
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;
skip
(* TODO: implementare *)
| None -> Ok rem
let all_collectors : (collector * event_description) 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);
]
let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result =
let () = if List.length ev = 0 then failwith "No events provided" in
let master, recurrence =
if List.length ev > 1 then begin
separate_master_and_recurrence ev
end
else begin
let ev = List.hd ev in
(ev, [])
end
in
let rem = { Remind.empty with Remind.recurring = recurrence } in
ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error (pred, _desc) ->
match rem_or_error with
| Error e -> Error e
| Ok rem -> pred rem master)

44
bin/main.ml Normal file
View File

@@ -0,0 +1,44 @@
open Remind_sync
module Map = MoreLabels.Map.Make (String)
(*
We use a list of events here because there can be multiple events with the same UID, and we want to preserve all of
them. This is important for handling cases where there are multiple events with the same UID but different properties
(e.g., due to updates or recurring events or cancellations).
*)
let ical2rem ical_file =
let ic = open_in ical_file 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); *)
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 () = if !Sys.interactive then () else exit (CommandLine.main ical2rem)

62
bin/remind.ml Normal file
View File

@@ -0,0 +1,62 @@
open Remind_sync
open Utils
type rem = {
original_uuid : string; (** Original UID from the iCalendar event *)
summary : string; (** Summary or title of the reminder *)
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) *)
recurring : Icalendar.event list;
(** List of events that are part of the same recurring series: these are only the overrides, not the master event
*)
}
[@@deriving show]
(** A complete REM command *)
let empty =
{
original_uuid = "";
summary = "";
date = Timedesc.Date.Ymd.make_exn ~year:1970 ~month:1 ~day:1;
end_date = None;
time = None;
duration = None;
simple_yearly = None;
recurring = [];
}
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
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

167
bin/utils.ml Normal file
View File

@@ -0,0 +1,167 @@
open Remind_sync
open Icalendar
type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
let month_of_int = function
| 1 -> Jan
| 2 -> Feb
| 3 -> Mar
| 4 -> Apr
| 5 -> May
| 6 -> Jun
| 7 -> Jul
| 8 -> Aug
| 9 -> Sep
| 10 -> Oct
| 11 -> Nov
| 12 -> Dec
| _ -> failwith "Invalid month number"
let string_of_month = function
| Jan -> "Jan"
| Feb -> "Feb"
| Mar -> "Mar"
| Apr -> "Apr"
| May -> "May"
| Jun -> "Jun"
| Jul -> "Jul"
| Aug -> "Aug"
| Sep -> "Sep"
| Oct -> "Oct"
| Nov -> "Nov"
| Dec -> "Dec"
let spf = Printf.sprintf
let get_uid ev =
let _, uid = ev.uid in
uid
(* Questa funzione serve solo da esempio per copia e incolla *)
let unpack_date_or_datetime (d_or_dt : Icalendar.date_or_datetime) =
match d_or_dt with
| `Datetime (`Local _ptime_ts) -> ()
| `Datetime (`Utc _ts) -> ()
| `Datetime (`With_tzid (_ts, (_b, _tz_name))) -> ()
| `Date (_year, _month, _day) -> ()
(* Questa funzione serve solo da esempio per copia e incolla *)
let unpack_dtend_or_duration dtend_or_dur =
match dtend_or_dur with
| None -> ()
| Some (`Dtend (_, date_or_datetime)) -> unpack_date_or_datetime date_or_datetime
| Some (`Duration (_, _duration)) -> ()
let string_of_time (t : Timedesc.Time.t) : string =
let view = Timedesc.Time.view t in
let hour, minute = (view.Timedesc.Time.hour, view.Timedesc.Time.minute) in
spf "%02d:%02d" hour minute
let string_of_span (sp : Timedesc.Span.t) : string =
let view = Timedesc.Span.For_human.view sp in
let hours, minutes = (view.Timedesc.Span.For_human.hours, view.Timedesc.Span.For_human.minutes) in
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
(* 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
| `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 ()
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 get_exdates ev =
let event_props = ev.props in
let dates_or_datetimes =
List.filter_map
(fun prop ->
match prop with
| `Exdate (_, dates) -> Some dates
| _ -> None)
event_props
in
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
let added =
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
let get_rdates ev =
let event_props = ev.props in
let dates_or_datetimes =
List.filter_map
(fun prop ->
match prop with
| `Rdate (_, dates) -> Some dates
| _ -> None)
event_props
in
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
let added =
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
let get_recurrence_id ev =
List.find_map
(fun prop ->
match prop with
| `Recur_id (_, date_or_datetime) -> Some date_or_datetime
| _ -> 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 master_and_recurrences =
List.partition_map
(fun (ev, recur_id_opt) ->
match recur_id_opt with
| None -> Right ev
| Some _ -> Left ev)
recur_ids
in
match master_and_recurrences with
| [], _ -> failwith "No master event found"
| master :: _, recurrences -> (master, recurrences)

5302
contrib/remind/remind_manual.txt Normal file
View File

File diff suppressed because it is too large Load Diff

1
dune Normal file
View File

@@ -0,0 +1 @@
(data_only_dirs contrib calendars)

24
dune-project Normal file
View File

@@ -0,0 +1,24 @@
(lang dune 3.20)
(name remind_sync)
(generate_opam_files true)
(source
(uri https://git.donadeo.net/pdonadeo/remind-sync))
(authors "Paolo Donadeo <paolo@donadeo.net>")
(maintainers "Maintainer Name <maintainer@example.com>")
(license MIT)
(documentation https://git.donadeo.net/pdonadeo/remind-sync)
(package
(name remind_sync)
(synopsis "A short synopsis")
(description "A longer description")
(depends ocaml)
(tags
("add topics" "to describe" your project)))

8
lib/dune Normal file
View File

@@ -0,0 +1,8 @@
(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))

316
lib/icalendar_augmented.ml Normal file
View File

@@ -0,0 +1,316 @@
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)

3
lib/ptime_augmented.ml Normal file
View File

@@ -0,0 +1,3 @@
include Ptime
type date = int * int * int [@@deriving show]

5
lib/remind_sync.ml Normal file
View File

@@ -0,0 +1,5 @@
module Icalendar = Icalendar_augmented
module Ptime = Ptime_augmented
module Result = Result_augmented
module Timedesc = Timedesc_augmented
module Utf8 = Utf8

42
lib/result_augmented.ml Normal file
View File

@@ -0,0 +1,42 @@
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

34
lib/timedesc_augmented.ml Normal file
View File

@@ -0,0 +1,34 @@
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 Normal file
View File

@@ -0,0 +1,202 @@
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

30
remind_sync.opam Normal file
View File

@@ -0,0 +1,30 @@
# 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)"]