course, ics: proper modules, proper datetime storage

Signed-off-by: Alban Gruin <alban at pa1ch dot fr>

6 files changed, 147 insertions, 50 deletions

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 <http://www.gnu.org/licenses/>.
+ *)
+
+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 <http://www.gnu.org/licenses/>.
+ *)
+
+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 <http://www.gnu.org/licenses/>.
+ *)
+
+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 <http://www.gnu.org/licenses/>.
+ *)
+
+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