fix(teacher_tab): Fix Open/Close handling w.r.t. Assignments

* Refactor and fix "Open"/"Closed"/… display code

* Add function `is_open_or_assigned_globally` in `Learnocaml_data` that returns
  ( GloballyOpen
  | GloballyOpenOrAssigned
  | GloballyClosedOrAssigned
  | GloballyClosed )

* Make invariants explicit in OCaml comments

* Add `check…` and `fix…` functions in `Learnocaml_data.Exercise.Status`
  to assert if the (assignments map, default) comply with the invariants
  (a false result means that there is at least one Open and one Closed)

Close ocaml-sf#534
Close ocaml-sf#558

Author: erikmd

src/app/learnocaml_teacher_tab.ml

@@ -299,13 +299,12 @@ let rec teacher_tab token _select _params () =
               H.td [stars_div meta.Exercise.Meta.stars];
               H.td [
                 let cls, text =
-                  match Token.Map.is_empty ES.(st.assignments.token_map),
-                        ES.(st.assignments.default) with
-                  | true, ES.Open -> "exo_open", [%i"Open"]
-                  | true, ES.Closed -> "exo_closed", [%i"Closed"]
-                  | _, (ES.Assigned _ | ES.Closed) ->
-                      "exo_assigned", [%i"Assigned"]
-                  | false, ES.Open -> "exo_assigned", [%i"Open/Assg"]
+                  let open ES in
+                  match is_open_or_assigned_globally st.assignments with
+                  | GloballyOpen -> "exo_open", [%i"Open"]
+                  | GloballyOpenOrAssigned -> "exo_assigned", [%i"Open/Assigned"]
+                  | GloballyClosedOrAssigned -> "exo_assigned", [%i"Assigned"]
+                  | GloballyClosed -> "exo_closed", [%i"Closed"]
                 in
                 H.span ~a:[H.a_class [cls]] [H.txt text]
               ];
@@ -856,17 +855,12 @@ let rec teacher_tab token _select _params () =
           let ids = htbl_keys selected_exercises in
           let fstat =
             if List.exists (fun id ->
-                let st = get_status id in
-                ES.(default_assignment st.assignments = Open))
+                   let st = get_status id in
+                   let open_assg = ES.is_open_or_assigned_globally st.ES.assignments in
+                   open_assg = ES.GloballyOpen || open_assg = ES.GloballyOpenOrAssigned)
                 ids
-            then ES.(fun assg ->
-                match default_assignment assg with
-                | Open -> set_default_assignment assg Closed
-                | _ -> assg)
-            else ES.(fun assg ->
-                match default_assignment assg with
-                | Closed -> set_default_assignment assg Open
-                | _ -> assg)
+            then ES.set_close_or_assigned_globally
+            else ES.set_open_or_assigned_globally
           in
           !exercise_status_change (htbl_keys selected_exercises) fstat;
           true)
@@ -1330,7 +1324,11 @@ let rec teacher_tab token _select _params () =
     in
     let open_exercises =
       SMap.fold (fun ex st acc ->
-          if ES.(st.assignments.default = Open) then ex::acc else acc)
+          let open ES in
+          let global_st = is_open_or_assigned_globally st.assignments in
+          if global_st = GloballyOpen
+             || global_st = GloballyOpenOrAssigned
+          then ex :: acc else acc)
         !status_map []
       |> List.rev
     in

src/state/learnocaml_data.ml

@@ -508,11 +508,96 @@ module Exercise = struct
 
     let set_default_assignment a default = {a with default}
 
+    let make_assignments token_map default =
+      { token_map; default }
+
     let get_status token a =
       match Token.Map.find_opt token a.token_map with
       | Some a -> a
       | None -> a.default
 
+    (* Global assignment status, w.r.t. all students as a whole
+
+        Invariants: forall exo_status : t,
+
+        1.(REQUIRED):
+        (exo_status.assignments.default <> Open && Token.Map.for_all (fun _ st -> st <> Open) exo_status.assignments.token_map)
+        || (exo_status.assignments.default <> Closed && Token.Map.for_all (fun _ st -> st <> Closed) exo_status.assignments.token_map)
+
+        2.(IfNormalized):
+        is_open_assigned_globally exo_status.assignments \in \{GloballyOpen, GloballyClosed\} ->
+        exo_status.assignments.token_map = Token.Map.empty *)
+    type global_status =
+      | GloballyOpen             (** "Open" *)
+      | GloballyClosed           (** "Closed" *)
+      | GloballyOpenOrAssigned   (** "Open/Assigned" *)
+      | GloballyClosedOrAssigned (** "Assigned" *)
+
+    let check_open_close a =
+      match a.default with
+      | Open ->
+         Token.Map.for_all (fun _tok st -> st <> Closed) a.token_map
+      | Closed ->
+         Token.Map.for_all (fun _tok st -> st <> Open) a.token_map
+      | Assigned _ ->
+         let o, c =
+           Token.Map.fold (fun _tok st (o, c) ->
+               (o && st <> Closed,
+                c && st <> Open)) a.token_map (true, true) in
+         o || c
+
+    let fix_open_close a =
+      let mp =
+        Token.Map.map (function Open -> Closed | st -> st) a.token_map in
+      match a.default with
+      | Open | Closed ->
+         make_assignments mp Closed
+      | assg ->
+         make_assignments mp assg
+
+    let check_and_fix_open_close a =
+      if check_open_close a then a
+      else fix_open_close a
+
+    let is_open_or_assigned_globally a =
+      match a.default with
+      | Open ->
+         if Token.Map.exists (fun _tok -> function Assigned _ -> true | _ -> false) a.token_map
+         then GloballyOpenOrAssigned
+         else GloballyOpen
+      | Closed ->
+         if Token.Map.exists (fun _tok -> function Assigned _ -> true | _ -> false) a.token_map
+         then GloballyClosedOrAssigned
+         else GloballyClosed
+      | Assigned _ ->
+         if Token.Map.exists (fun _tok -> (=) Open) a.token_map
+         then GloballyOpenOrAssigned
+         else GloballyClosedOrAssigned
+
+    let set_close_or_assigned_globally a =
+      match is_open_or_assigned_globally a with
+      | GloballyOpen -> make_assignments Token.Map.empty Closed
+      | GloballyOpenOrAssigned ->
+         make_assignments
+           (Token.Map.map (function Open -> Closed | st -> st) a.token_map)
+           (match a.default with Open -> Closed | a -> a)
+      (* otherwise, maybe: forget the map and re-add all tokens ? *)
+      | GloballyClosedOrAssigned -> a
+      | GloballyClosed -> a
+
+    let set_open_or_assigned_globally a =
+      match is_open_or_assigned_globally a with
+      | GloballyClosed -> make_assignments Token.Map.empty Open
+      | GloballyClosedOrAssigned ->
+         make_assignments
+           (Token.Map.map (function Closed -> Open | st -> st) a.token_map)
+           (match a.default with Closed -> Open | a -> a)
+      (* otherwise, maybe: forget the map and re-add all tokens ? *)
+      | GloballyOpenOrAssigned -> a
+      | GloballyOpen -> a
+
+    (* Note/Erik: we may also want to implement set_assigned_globally *)
+
     let is_open_assignment token a =
       match get_status token a with
       | Assigned a ->
@@ -640,9 +725,6 @@ module Exercise = struct
         skills_focus;
         assignments = { default; token_map } }
 
-    let make_assignments token_map default =
-      { token_map; default }
-
     let enc =
       let status_enc =
         J.union [

src/state/learnocaml_data.mli

@@ -203,9 +203,53 @@ module Exercise: sig
 
     val set_default_assignment: assignments -> status -> assignments
 
+    val make_assignments:
+      status Token.Map.t -> status -> assignments
+
     val get_status:
       Token.t -> assignments -> status
 
+    (** Global assignment status, w.r.t. all students as a whole
+
+        Invariants: forall exo_status : t,
+
+        1.(REQUIRED):
+        (exo_status.assignments.default <> Open && Token.Map.for_all (fun _ st -> st <> Open) exo_status.assignments.token_map)
+        || (exo_status.assignments.default <> Closed && Token.Map.for_all (fun _ st -> st <> Closed) exo_status.assignments.token_map)
+
+        2.(IfNormalized):
+        is_open_assigned_globally exo_status.assignments \in \{GloballyOpen, GloballyClosed\} ->
+        exo_status.assignments.token_map = Token.Map.empty *)
+    type global_status =
+      | GloballyOpen             (** "Open" *)
+      | GloballyClosed           (** "Closed" *)
+      | GloballyOpenOrAssigned   (** "Open/Assigned" *)
+      | GloballyClosedOrAssigned (** "Assigned" *)
+
+    val is_open_or_assigned_globally: assignments -> global_status
+
+    (** Close assignments status globally (for all unassigned students), namely:
+        - GloballyOpen -> GloballyClosed
+        - GloballyOpenOrAssigned -> GloballyClosedOrAssigned
+        - other -> no-op *)
+    val set_close_or_assigned_globally: assignments -> assignments
+
+    (** Open assignments status globally (for all unassigned students), namely:
+        - GloballyClosed -> GloballyOpen
+        - GloballyClosedOrAssigned -> GloballyOpenOrAssigned
+        - other -> no-op *)
+    val set_open_or_assigned_globally: assignments -> assignments
+
+    (** Check if the assignments map and default comply with the invariants.
+        Return false if there are at least one Open and at least one Closed. *)
+    val check_open_close: assignments -> bool
+
+    (** Replace all Open with Closed. *)
+    val fix_open_close: assignments -> assignments
+
+    (** Call [check_open_close] then (if need be) [fix_open_close] *)
+    val check_and_fix_open_close: assignments -> assignments
+
     val is_open_assignment:
       Token.t -> assignments -> [> `Open | `Closed | `Deadline of float]
 
@@ -241,9 +285,6 @@ module Exercise: sig
     val three_way_merge:
       ancestor:t -> theirs:t -> ours:t -> t
 
-    val make_assignments:
-      status Token.Map.t -> status -> assignments
-
     val enc: t Json_encoding.encoding
 
   end

translations/fr.po

@@ -633,7 +633,7 @@ msgid "Assigned"
 msgstr "Devoir"
 
 #: File "src/app/learnocaml_teacher_tab.ml", line 308, characters 57-68
-msgid "Open/Assg"
+msgid "Open/Assigned"
 msgstr "Ouvert/Devoir"
 
 #: File "src/app/learnocaml_teacher_tab.ml", line 368, characters 49-61 391,