diff options
author | Alban Gruin | 2021-09-16 21:55:11 +0200 |
---|---|---|
committer | Alban Gruin | 2021-09-19 12:37:38 +0200 |
commit | 9a84c508cd498c4331e35407f1da192fff8a6d19 (patch) | |
tree | a221a1d72c804018660da1a616f3eb6cde197bdb | |
parent | cb2f075c326f40c27b4c6d9dde6fd51b78a43f9c (diff) |
server: allow to fetch module timetables in addition to groups
This add a new type, fetch_kind, and a function, kind_to_res_type, to
select the type of timetable we want to fetch: Group, or Module. For
now, Module is not used, so warning 37 is disabled in fetch_kind. It
will be enabled back in the next commit.
Signed-off-by: Alban Gruin <alban at pa1ch dot fr>
-rw-r--r-- | src/server.ml | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/src/server.ml b/src/server.ml index a27e5d6..7107fdf 100644 --- a/src/server.ml +++ b/src/server.ml @@ -1,5 +1,5 @@ (* - * Copyright (C) 2020 Alban Gruin + * Copyright (C) 2020, 2021 Alban Gruin * * ucs is free software: you can redistribute it and/or modify * it under the terms of the GNU Affero General Public License as published @@ -26,13 +26,22 @@ let format_date = Printer.Date.sprint "%Y-%m-%d" and a_month = Date.Period.make 0 1 0 and a_year = Date.Period.make 1 0 0 -let fetch celcat_url group = +type [@warning "-37"] fetch_kind = + | Group + | Module + +let kind_to_res_type = function + | Group -> "103" + | Module -> "100" + +let fetch celcat_url group kind = let current_date = Date.today () in let lower_date = format_date @@ Date.rem current_date a_month and upper_date = format_date @@ Date.add current_date a_year in + let res_type = kind_to_res_type kind in let parameters = Uri.encoded_of_query ["start", [lower_date]; "end", [upper_date]; - "resType", ["103"]; "calView", ["month"]; + "resType", [res_type]; "calView", ["month"]; "federationIds[]", [group]; "colourScheme", ["3"]] in let body = Cohttp_lwt.Body.of_string parameters and headers = Header.init_with "Content-Type" "application/x-www-form-urlencoded" in @@ -63,7 +72,6 @@ let get_tz () = let serve base_url celcat_url mode stop = get_tz () >>= fun tzname -> - let fetch = fetch celcat_url in let callback _conn req _body = let meth = Request.meth req and uri = Request.uri req in @@ -81,7 +89,7 @@ let serve base_url celcat_url mode stop = Server.respond_string ~status:`Bad_request ~body:"Bad request\n" () | `GET, ["ics"; file], [] when Astring.String.is_suffix ~affix:".ics" file -> let group = String.(sub file 0 (length file - 4)) in - fetch group >>= fun body -> + fetch celcat_url group Group >>= fun body -> Course.decode body |> Ics.to_string tzname |> respond ~mime:"text/calendar; charset=utf-8" |