Skip to content
Snippets Groups Projects
Commit 6fa6a8cb authored by Emmanuel Coquery's avatar Emmanuel Coquery
Browse files

Added interface for timetable

parent 7f4bb051
No related branches found
No related tags found
No related merge requests found
...@@ -27,6 +27,10 @@ _opam: ...@@ -27,6 +27,10 @@ _opam:
build: _opam build: _opam
opam exec dune build opam exec dune build
# continuous build
watch: _opam
opam exec -- dune build --watch
# help: shows the possible targets # help: shows the possible targets
help: help:
@sed -ne 's/^#\(.*\)$$/\1/p' Makefile @sed -ne 's/^#\(.*\)$$/\1/p' Makefile
......
...@@ -19,7 +19,7 @@ ...@@ -19,7 +19,7 @@
(name ocaml_edt) (name ocaml_edt)
(synopsis "Generates timetables for course planification") (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") (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 calendar) (depends ocaml dune cmdliner calendar yojson)
(tags (tags
(topics "timetable"))) (topics "timetable")))
......
(** Lexicographic order comparisons *)
let lex access cmp fn v1 v2 = let lex access cmp fn v1 v2 =
let v = fn v1 v2 in let v = fn v1 v2 in
if v != 0 then v else cmp (access v1) (access v2) if v != 0 then v else cmp (access v1) (access v2)
let lex_r access cmp fn v1 v2 = (* let lex_r access cmp fn v1 v2 =
let v = cmp (access v1) (access v2) in let v = cmp (access v1) (access v2) in
if v != 0 then v else fn v1 v2 if v != 0 then v else fn v1 v2 *)
let eq _ _ = 0 let eq _ _ = 0
let rec gcd n m = if m = 0 then n else gcd m (n mod m) (* let rec gcd n m = if m = 0 then n else gcd m (n mod m) *)
type date = CalendarLib.Date.t type date = CalendarLib.Date.t
type heure = int
let as_iso (d : date) : string = CalendarLib.Printer.Date.sprint "%F" d let heure (h : int) (m : int) : heure = (h * 60) + m
type 'a cell = { rowspan : int; colspan : int; content : 'a } (* let as_iso (d : date) : string = CalendarLib.Printer.Date.sprint "%F" d *)
type 'a line = { headers : string cell list; cells : 'a cell list }
type 'a table = { (* type 'a cell = { rowspan : int; colspan : int; content : 'a }
columns_headers : string cell list list; type 'a line = { headers : string cell list; cells : 'a cell list }
lines : 'a line list;
} type 'a table = {
columns_headers : string cell list list;
lines : 'a line list;
} *)
module type ResourcesT = sig module type ResourcesT = sig
type t type t
...@@ -31,11 +35,9 @@ end ...@@ -31,11 +35,9 @@ end
module Make (R : ResourcesT) = struct module Make (R : ResourcesT) = struct
module D = CalendarLib.Date 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 } type creneau = { resources : R.t; date : date; start : heure; duration : int }
type creneaux = creneau list
type week = date * creneaux
let compare = let compare =
eq eq
...@@ -52,7 +54,7 @@ module Make (R : ResourcesT) = struct ...@@ -52,7 +54,7 @@ module Make (R : ResourcesT) = struct
|| inside c2.start c1.start c1.duration) || inside c2.start c1.start c1.duration)
let conflict c1 c2 = intersect c1 c2 && R.conflicts c1.resources c2.resources let conflict c1 c2 = intersect c1 c2 && R.conflicts c1.resources c2.resources
let date = D.make (* let date = D.make *)
let week_of_date d : date = let week_of_date d : date =
let day = D.day_of_week d in let day = D.day_of_week d in
...@@ -72,8 +74,7 @@ module Make (R : ResourcesT) = struct ...@@ -72,8 +74,7 @@ module Make (R : ResourcesT) = struct
let l_s = supprime_conflits raise_exc c rest in let l_s = supprime_conflits raise_exc c rest in
if l_s == rest then l else l_s if l_s == rest then l else l_s
let rec place (raise_exc : bool) (c : creneau) (l : creneau list) : let rec place (raise_exc : bool) (c : creneau) (l : creneaux) : creneaux =
creneau list =
match l with match l with
| [] -> [ c ] | [] -> [ c ]
| c' :: rest when conflict c c' -> place raise_exc c rest | c' :: rest when conflict c c' -> place raise_exc c rest
...@@ -96,4 +97,9 @@ module Make (R : ResourcesT) = struct ...@@ -96,4 +97,9 @@ module Make (R : ResourcesT) = struct
aux l aux l
let by_week l = groupby (fun c -> week_of_date c.date) D.compare compare l let by_week l = groupby (fun c -> week_of_date c.date) D.compare compare l
let week_start : week -> date = fst
let to_fullcalendar (_cr : (date * creneau list) list) : Yojson.Safe.t =
(* let open Yojson.Safe in *)
`Null
end end
type date = CalendarLib.Date.t
type heure
val heure : int -> int -> heure
module type ResourcesT = sig
type t
val conflicts : t -> t -> bool
val compare : t -> t -> int
end
module Make (R : ResourcesT) : sig
type creneau = { resources : R.t; date : date; start : heure; duration : int }
(** Type pour représenter un créneau associé à des ressources *)
type creneaux
(** Représente un ensemble de créneaux *)
type week
(** Représente une semaine *)
exception Conflit of (creneau * creneau)
(** Conflit de créneaux *)
val place : bool -> creneau -> creneaux -> creneaux
(** [place b cr crl] ajoute le créneau [cr] à la liste des créneaux [crl] si
ce créneau rentre en conflit avec un créneau dans [crl], alors si [b]
vaut [true] une exception [Conflit] est levée. Si [b] vaut [false], alors
le nouveau créneau prend la place des créneaux avec lesquels il est en
conflit.
*)
val by_week : creneaux -> week list
(** [by_week] prend un paquet de créneaux et construit une liste de semaines *)
val week_start : week -> date
(** date du premier jour de la semaine *)
val to_fullcalendar : week list -> Yojson.Safe.t
(** convertit un ensemble de semaines en structure json utilisable comme
donnée pour le composant javascript FullCalendar *)
end
(library (library
(name ocaml_edt) (name ocaml_edt)
(libraries calendar)) (libraries calendar yojson))
...@@ -15,6 +15,7 @@ depends: [ ...@@ -15,6 +15,7 @@ depends: [
"dune" {>= "3.16"} "dune" {>= "3.16"}
"cmdliner" "cmdliner"
"calendar" "calendar"
"yojson"
"odoc" {with-doc} "odoc" {with-doc}
] ]
build: [ build: [
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment