From 7f4bb051c4d8d9fe9787690c9c8a6b93c716a339 Mon Sep 17 00:00:00 2001
From: Emmanuel Coquery <emmanuel.coquery@univ-lyon1.fr>
Date: Tue, 10 Sep 2024 09:52:41 +0200
Subject: [PATCH] Backport of core representation from grid

---
 dune-project     |  2 +-
 lib/Timetable.ml | 99 ++++++++++++++++++++++++++++++++++++++++++++++++
 lib/dune         |  3 +-
 ocaml_edt.opam   |  1 +
 4 files changed, 103 insertions(+), 2 deletions(-)
 create mode 100644 lib/Timetable.ml

diff --git a/dune-project b/dune-project
index 94169d7..64e3c95 100644
--- a/dune-project
+++ b/dune-project
@@ -19,7 +19,7 @@
  (name ocaml_edt)
  (synopsis "Generates timetables for course planification")
  (description "Program and library to generate a timetable for a course or a set of courses, outputs in HTML format among others")
- (depends ocaml dune cmdliner)
+ (depends ocaml dune cmdliner calendar)
  (tags
   (topics "timetable")))
 
diff --git a/lib/Timetable.ml b/lib/Timetable.ml
new file mode 100644
index 0000000..6b1e7dd
--- /dev/null
+++ b/lib/Timetable.ml
@@ -0,0 +1,99 @@
+let lex access cmp fn v1 v2 =
+  let v = fn v1 v2 in
+  if v != 0 then v else cmp (access v1) (access v2)
+
+let lex_r access cmp fn v1 v2 =
+  let v = cmp (access v1) (access v2) in
+  if v != 0 then v else fn v1 v2
+
+let eq _ _ = 0
+let rec gcd n m = if m = 0 then n else gcd m (n mod m)
+
+type date = CalendarLib.Date.t
+
+let as_iso (d : date) : string = CalendarLib.Printer.Date.sprint "%F" d
+
+type 'a cell = { rowspan : int; colspan : int; content : 'a }
+type 'a line = { headers : string cell list; cells : 'a cell list }
+
+type 'a table = {
+  columns_headers : string cell list list;
+  lines : 'a line list;
+}
+
+module type ResourcesT = sig
+  type t
+
+  val conflicts : t -> t -> bool
+  val compare : t -> t -> int
+end
+
+module Make (R : ResourcesT) = struct
+  module D = CalendarLib.Date
+
+  type heure = int
+
+  let heure (h : int) (m : int) : heure = (h * 60) + m
+
+  type creneau = { resources : R.t; date : date; start : heure; duration : int }
+
+  let compare =
+    eq
+    |> lex (fun c -> c.date) D.compare
+    |> lex (fun c -> c.start) ( - )
+    |> lex (fun c -> c.duration) ( - )
+    |> lex (fun c -> c.resources) R.compare
+
+  let inside h h' d = h' <= h && h <= h' + d
+
+  let intersect c1 c2 =
+    c1.date = c2.date
+    && (inside c1.start c2.start c2.duration
+       || inside c2.start c1.start c1.duration)
+
+  let conflict c1 c2 = intersect c1 c2 && R.conflicts c1.resources c2.resources
+  let date = D.make
+
+  let week_of_date d : date =
+    let day = D.day_of_week d in
+    let offset = 1 - D.int_of_day day in
+    D.add d (D.Period.day offset)
+
+  exception Conflit of (creneau * creneau)
+
+  let rec supprime_conflits raise_exc c l =
+    match l with
+    | [] -> l
+    | c' :: rest ->
+        if conflict c c' then
+          if raise_exc then raise (Conflit (c, c'))
+          else supprime_conflits raise_exc c rest
+        else
+          let l_s = supprime_conflits raise_exc c rest in
+          if l_s == rest then l else l_s
+
+  let rec place (raise_exc : bool) (c : creneau) (l : creneau list) :
+      creneau list =
+    match l with
+    | [] -> [ c ]
+    | c' :: rest when conflict c c' -> place raise_exc c rest
+    | c' :: rest when compare c' c <= 0 -> c' :: place raise_exc c rest
+    | c' :: rest -> c :: c' :: supprime_conflits raise_exc c rest
+
+  let groupby gv cmp cmp2 l =
+    let l = List.map (fun c -> (gv c, c)) l in
+    let cmp_p = eq |> lex fst cmp |> lex snd cmp2 in
+    let l = List.sort cmp_p l in
+    let rec aux = function
+      | [] -> []
+      | (v, c) :: rest -> (
+          match aux rest with
+          | [] -> [ (v, [ c ]) ]
+          | (v', cs') :: rest' ->
+              if v = v' then (v', c :: cs') :: rest'
+              else (v, [ c ]) :: (v', cs') :: rest')
+    in
+    aux l
+
+  let by_week l = groupby (fun c -> week_of_date c.date) D.compare compare l
+end
diff --git a/lib/dune b/lib/dune
index cfb89e8..f7645f9 100644
--- a/lib/dune
+++ b/lib/dune
@@ -1,2 +1,3 @@
 (library
- (name ocaml_edt))
+ (name ocaml_edt)
+ (libraries calendar))
diff --git a/ocaml_edt.opam b/ocaml_edt.opam
index fc7a0ec..a832823 100644
--- a/ocaml_edt.opam
+++ b/ocaml_edt.opam
@@ -14,6 +14,7 @@ depends: [
   "ocaml"
   "dune" {>= "3.16"}
   "cmdliner"
+  "calendar"
   "odoc" {with-doc}
 ]
 build: [
-- 
GitLab