From d4c1438505ff79e3607ed5d2eb2ee8fbe203b298 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Wed, 9 Sep 2020 21:00:29 +0200 Subject: course, ics: proper modules, proper datetime storage Signed-off-by: Alban Gruin --- src/course.ml | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/course.mli | 18 +++++++++++++++++ src/dune | 6 +++++- src/ics.ml | 26 ++++++++++++++++++++++++ src/ics.mli | 24 ++++++++++++++++++++++ src/ucs.ml | 60 ++++++++++--------------------------------------------- 6 files changed, 147 insertions(+), 50 deletions(-) create mode 100644 src/course.ml create mode 100644 src/course.mli create mode 100644 src/ics.ml create mode 100644 src/ics.mli (limited to 'src') diff --git a/src/course.ml b/src/course.ml new file mode 100644 index 0000000..2e5c758 --- /dev/null +++ b/src/course.ml @@ -0,0 +1,63 @@ +(* + * Copyright (C) 2020 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 + * by the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * ucs is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with ucs. If not, see . + *) + +open CalendarLib +open Ics + +module J = Json_encoding + +let date_format = "%FT%T" +let default_date = Calendar.make 1970 1 1 0 0 0 + +let date = + Printer.Calendar.( + J.(conv (sprint date_format) (from_fstring date_format) string)) + +let encoding = + J.(conv + (fun _ -> ("", default_date, default_date, false, "", (), (), (), (), ""), + ([], None, (), (), (), (), ())) + (fun ((_id, start, stop, _allDay, summary, (), (), (), (), category), + (_sites, _modules, (), (), (), (), ())) -> + {start; stop; summary; category; location=""}) + (merge_objs + (obj10 + (req "id" string) + (req "start" date) + (req "end" date) + (req "allDay" bool) + (req "description" string) + (req "backgroundColor" unit) + (req "textColor" unit) + (req "department" unit) + (req "faculty" unit) + (req "eventCategory" string)) + (obj7 + (req "sites" @@ list string) + (req "modules" @@ option (list string)) + (req "registerStatus" unit) + (req "studentMark" unit) + (req "custom1" unit) + (req "custom2" unit) + (req "custom3" unit)))) + +let decode s = + let toks = + match s with + | "" -> `O [] + | s -> Ezjsonm.from_string s in + J.destruct (J.list encoding) toks diff --git a/src/course.mli b/src/course.mli new file mode 100644 index 0000000..a91954d --- /dev/null +++ b/src/course.mli @@ -0,0 +1,18 @@ +(* + * Copyright (C) 2020 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 + * by the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * ucs is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with ucs. If not, see . + *) + +val decode : string -> Ics.event list diff --git a/src/dune b/src/dune index a31d206..e87f710 100644 --- a/src/dune +++ b/src/dune @@ -1,3 +1,7 @@ (executable (name ucs) - (libraries lwt.unix cohttp-lwt-unix ezjsonm ocplib-json-typed)) + (libraries calendar + lwt.unix + cohttp-lwt-unix + ezjsonm + ocplib-json-typed)) diff --git a/src/ics.ml b/src/ics.ml new file mode 100644 index 0000000..5bfecb0 --- /dev/null +++ b/src/ics.ml @@ -0,0 +1,26 @@ +(* + * Copyright (C) 2020 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 + * by the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * ucs is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with ucs. If not, see . + *) + +open CalendarLib + +type event = { + start: Calendar.t; + stop: Calendar.t; + summary: string; + category: string; + location: string + } diff --git a/src/ics.mli b/src/ics.mli new file mode 100644 index 0000000..352ce68 --- /dev/null +++ b/src/ics.mli @@ -0,0 +1,24 @@ +(* + * Copyright (C) 2020 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 + * by the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * ucs is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with ucs. If not, see . + *) + +type event = { + start: CalendarLib.Calendar.t; + stop: CalendarLib.Calendar.t; + summary: string; + category: string; + location: string + } diff --git a/src/ucs.ml b/src/ucs.ml index 1732614..121ac7a 100644 --- a/src/ucs.ml +++ b/src/ucs.ml @@ -19,59 +19,21 @@ open Lwt open Cohttp open Cohttp_lwt_unix -module J = Json_encoding - -type course = { - start: string; - stop: string; - description: string; - category: string; - place: string } - -let encoding = - J.(conv - (fun _ -> ("", "", "", false, "", (), (), (), (), ""), - ([], None, (), (), (), (), ())) - (fun ((_id, start, stop, _allDay, description, (), (), (), (), category), - (_sites, _modules, (), (), (), (), ())) -> - {start; stop; description; category; place=""}) - (merge_objs - (obj10 - (req "id" string) - (req "start" string) - (req "end" string) - (req "allDay" bool) - (req "description" string) - (req "backgroundColor" unit) - (req "textColor" unit) - (req "department" unit) - (req "faculty" unit) - (req "eventCategory" string)) - (obj7 - (req "sites" @@ list string) - (req "modules" @@ option (list string)) - (req "registerStatus" unit) - (req "studentMark" unit) - (req "custom1" unit) - (req "custom2" unit) - (req "custom3" unit)))) - -let decode enc s = - let toks = - match s with - | "" -> `O [] - | s -> Ezjsonm.from_string s in - J.destruct enc toks - let body = - let parameters = "start=2020-09-01&end=2020-10-01&resType=103&calView=month&federationIds[]=IINS9CMA&colourScheme=3" in + let parameters = Uri.encoded_of_query + ["start", ["2020-09-01"]; "end", ["2020-10-01"]; + "resType", ["103"]; "calView", ["month"]; + "federationIds[]", ["IINS9CMA"]; "colourScheme", ["3"]] in let body = Cohttp_lwt.Body.of_string parameters and headers = Header.init_with "Content-Type" "application/x-www-form-urlencoded" in - Client.post ~body ~headers (Uri.of_string "https://edt.univ-tlse3.fr/calendar2/Home/GetCalendarData") >>= fun (_resp, body) -> + Client.post ~body ~headers (Uri.of_string "https://edt.univ-tlse3.fr/calendar2/Home/GetCalendarData") + >>= fun (_resp, body) -> Cohttp_lwt.Body.to_string body +let dump_date = CalendarLib.Printer.Calendar.to_string + let () = let body = Lwt_main.run body in - List.iter (fun {start; stop; description; category; place} -> - Printf.printf "%s\n%s\n%s\n%s\n%s\n\n" start stop description category place) - @@ decode (J.list encoding) body + List.iter (fun Ics.{start; stop; summary; category; location} -> + Printf.printf "%s\n%s\n%s\n%s\n%s\n\n" (dump_date start) (dump_date stop) summary category location) + @@ Course.decode body -- cgit v1.2.1