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>

5 files changed, 45 insertions, 1 deletions

diff --git a/src/ics.ml b/src/ics.ml
index be7fb18..4840590 100644
--- a/src/ics.ml
+++ b/src/ics.ml
@@ -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 ()