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 <alban@pa1ch.fr>
---
 src/course.ml | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)
 create mode 100644 src/course.ml

(limited to 'src/course.ml')

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
-- 
cgit v1.2.1