diff options
author | Alban Gruin | 2022-02-05 15:16:18 +0100 |
---|---|---|
committer | Alban Gruin | 2022-02-05 15:18:19 +0100 |
commit | a55229d34abeb85d9adaca615c9905c7b06a81e1 (patch) | |
tree | 9735a5e37101dd699bebc6777d403f50d804f935 | |
parent | ee3b01bf7027798ba23153aef7f4ccc57f5f7b38 (diff) |
Introduce a new feature to list events without location
This adds a new page listing events without location.
Signed-off-by: Alban Gruin <alban at pa1ch dot fr>
-rw-r--r-- | src/ics.ml | 3 | ||||
-rw-r--r-- | src/ics.mli | 3 | ||||
-rw-r--r-- | src/pages.ml | 24 | ||||
-rw-r--r-- | src/pages.mli | 1 | ||||
-rw-r--r-- | src/server.ml | 15 |
5 files changed, 45 insertions, 1 deletions
@@ -68,6 +68,9 @@ module Event = struct |> List.map ics_split_line |> String.concat "\r\n" + let format_fields fn event = + fn event.summary event.groups event.start event.stop + let has_groups groups event = List.fold_left (fun found group -> found || List.exists ((=) group) groups) false event.groups diff --git a/src/ics.mli b/src/ics.mli index e3dd577..e9e927c 100644 --- a/src/ics.mli +++ b/src/ics.mli @@ -22,6 +22,9 @@ module Event : sig string -> string option -> string list -> t val to_string : string -> t -> int -> string + val format_fields : + (string -> string list -> CalendarLib.Calendar.t -> CalendarLib.Calendar.t -> string) -> + t -> string end type t = Event.t list diff --git a/src/pages.ml b/src/pages.ml index 6fd7bef..c8f8c2e 100644 --- a/src/pages.ml +++ b/src/pages.ml @@ -147,3 +147,27 @@ let select module_id groups = <input type="submit" value="Générer un ICS" /> </form> |} + +let empty_events events = + let format_event name _groups start stop = + let escape () = escape and + to_hour = CalendarLib.Printer.Calendar.sprint "%H:%M" and + to_date = CalendarLib.Printer.Calendar.sprint "%d/%m/%Y" in + Printf.sprintf " <li>%a, le %a de %a à %a</li>" + escape name + escape (to_date start) + escape (to_hour start) + escape (to_hour stop) in + let formatted_events = + match events with + | [] -> " <li>Aucun cours sans salle dans cet emploi du temps.</li>" + | events -> + List.map (Ics.Event.format_fields format_event) events + |> String.concat "\n" in + common @@ {| + <h3>Liste des cours sans salle</h3> + <ul> +|} ^ formatted_events ^ + {| + </ul> +|} diff --git a/src/pages.mli b/src/pages.mli index 4618faf..f75a759 100644 --- a/src/pages.mli +++ b/src/pages.mli @@ -18,3 +18,4 @@ val main : string val link : ?args:(string * string list) -> string -> string val select : string -> string Seq.t -> string +val empty_events : Ics.t -> string diff --git a/src/server.ml b/src/server.ml index 287a416..efd0f0d 100644 --- a/src/server.ml +++ b/src/server.ml @@ -126,6 +126,17 @@ let get_module_link base_url body = respond_link ~groups base_url Module module_id) bad_request +let list_events_with_empty_location celcat_url body = + get_module_and_groups_from_request body + (fun module_id groups -> + fetch celcat_url module_id Module >>= fun body -> + Course.decode body + |> skip_if (groups = []) (Ics.filter_groups groups) + |> Ics.filter_empty_locations + |> Pages.empty_events + |> respond) + bad_request + let check_ics = Astring.String.is_suffix ~affix:".ics" let serve base_url celcat_url mode stop = @@ -155,7 +166,9 @@ let serve base_url celcat_url mode stop = |> Ics.get_all_groups |> Pages.select module_id |> respond - | (`GET | `POST), ["lnk"], _ | `GET, ["filter"], _ -> + | `POST, ["empty"], [] -> + list_events_with_empty_location celcat_url body + | (`GET | `POST), ["lnk"], _ | `GET, ["filter"], _ | `POST, ["empty"], _ -> bad_request () | `GET, ["ics"; "g" | "m"; file], _ when check_ics file -> bad_request () |