Merge pull request #559 from pfitaxel/fix-open-close

fix(teacher_tab): partly fix Open/Close handling w.r.t. Assignments Close #534 Related: #558
ocaml-sf · Sep 15, 2023 · 2b84fc4 · 2b84fc4
2 parents b4d68e8 + 10c9fc3
commit 2b84fc4
Show file tree

Hide file tree

Showing 12 changed files with 368 additions and 47 deletions.
diff --git a/.ci-macosx.sh b/.ci-macosx.sh
@@ -35,7 +35,13 @@ opam init -y -a --bare
 
 opam switch create . ocaml-base-compiler --deps-only --locked -y -j 2 # -v
 eval $(opam env)
+
+# Run unit tests
+# Note: we might want to run them in Linux as well in the CI
+make test
+
 make
+
 make opaminstall
 
 # See src/main/linking_flags.sh

diff --git a/Makefile b/Makefile
@@ -11,6 +11,14 @@ build-deps:
 build:
 	@${DUNE} build ${DUNE_ARGS}
 
+.PHONY: test
+test:
+	@${DUNE} runtest --root .
+
+.PHONY: test-promote
+test-promote:
+	@${DUNE} runtest --root . --auto-promote
+
 .PHONY: static
 static:
 	@${MAKE} -C static

diff --git a/learn-ocaml-client.opam b/learn-ocaml-client.opam
@@ -39,8 +39,10 @@ depends: [
   "ocplib-json-typed" {>= "0.7"}
   "ocp-ocamlres" {>= "0.4"}
   "omd" {<= "1.3.1"}
-  "ppx_fields_conv"
   "ppxlib"
+  "ppx_expect"
+  "ppx_inline_test"
+  "ppx_fields_conv"
   "ppx_sexp_conv"
   "ppx_tools"
   "ssl" {= "0.5.12"}

diff --git a/learn-ocaml-client.opam.locked b/learn-ocaml-client.opam.locked
@@ -42,7 +42,6 @@ depends: [
   "conduit-lwt-unix" {= "1.3.0"}
   "conf-libssl" {= "3"}
   "conf-pkg-config" {= "2"}
-  "conf-which" {= "1"}
   "cppo" {= "1.6.7"}
   "csexp" {= "1.5.1"}
   "cstruct" {= "5.0.0"}
@@ -57,11 +56,12 @@ depends: [
   "gg" {= "0.9.3"}
   "hex" {= "1.4.0"}
   "ipaddr" {= "2.9.0"}
-  "jbuilder" {= "1.0+beta20.2"}
+  "jane-street-headers" {= "v0.14.0"}
   "js_of_ocaml" {= "3.9.0"}
   "js_of_ocaml-compiler" {= "3.9.1"}
   "js_of_ocaml-ppx" {= "3.9.0"}
   "jsonm" {= "1.0.1"}
+  "jst-config" {= "v0.14.1"}
   "logs" {= "0.7.0"}
   "lwt" {= "5.4.1"}
   "lwt_ssl" {= "1.1.3"}
@@ -83,11 +83,23 @@ depends: [
   "ocp-ocamlres" {= "0.4"}
   "ocplib-endian" {= "1.1"}
   "ocplib-json-typed" {= "0.7.1"}
+  "octavius" {= "1.2.2"}
   "omd" {= "1.3.1"}
   "parsexp" {= "v0.14.1"}
   "pprint" {= "20200410"}
+  "ppx_assert" {= "v0.14.0"}
+  "ppx_base" {= "v0.14.0"}
+  "ppx_cold" {= "v0.14.0"}
+  "ppx_compare" {= "v0.14.0"}
   "ppx_derivers" {= "1.2.1"}
+  "ppx_enumerate" {= "v0.14.0"}
+  "ppx_expect" {= "v0.14.0"}
   "ppx_fields_conv" {= "v0.14.1"}
+  "ppx_hash" {= "v0.14.0"}
+  "ppx_here" {= "v0.14.0"}
+  "ppx_inline_test" {= "v0.14.1"}
+  "ppx_js_style" {= "v0.14.1"}
+  "ppx_optcomp" {= "v0.14.0"}
   "ppx_sexp_conv" {= "v0.14.1"}
   "ppx_tools" {= "6.3"}
   "ppxlib" {= "0.15.0"}
@@ -97,8 +109,10 @@ depends: [
   "sexplib" {= "v0.14.0"}
   "sexplib0" {= "v0.14.0"}
   "ssl" {= "0.5.12"}
+  "stdio" {= "v0.14.0"}
   "stdlib-shims" {= "0.3.0"}
   "stringext" {= "1.6.0"}
+  "time_now" {= "v0.14.0"}
   "topkg" {= "1.0.3"}
   "uchar" {= "0.0.2"}
   "uri" {= "4.2.0"}

diff --git a/learn-ocaml.opam b/learn-ocaml.opam
@@ -54,8 +54,10 @@ depends: [
   "odoc" {build}
   "omd" {<= "1.3.1"}
   "pprint"
-  "ppx_cstruct"
   "ppxlib"
+  "ppx_cstruct"
+  "ppx_expect"
+  "ppx_inline_test"
   "ppx_sexp_conv"
   "ppx_tools"
   "ppx_tools_versioned"
@@ -70,6 +72,7 @@ build: [
   ["dune" "build" "-p" name "-j" jobs]
   [make "detect-libs"] {with-test}
 ]
+run-test: [make "test"]
 install: [
   ["mkdir" "-p" "%{_:share}%"]
   ["cp" "-r" "demo-repository" "%{_:share}%/repository"]

diff --git a/learn-ocaml.opam.locked b/learn-ocaml.opam.locked
@@ -57,14 +57,15 @@ depends: [
   "gg" {= "0.9.3"}
   "hex" {= "1.4.0"}
   "ipaddr" {= "2.9.0"}
-  "jbuilder" {= "1.0+beta20.2"}
+  "jane-street-headers" {= "v0.14.0"}
   "js_of_ocaml" {= "3.9.0"}
   "js_of_ocaml-compiler" {= "3.9.1"}
   "js_of_ocaml-lwt" {= "3.9.0"}
   "js_of_ocaml-ppx" {= "3.9.0"}
   "js_of_ocaml-toplevel" {= "3.9.0"}
   "js_of_ocaml-tyxml" {= "3.9.0"}
   "jsonm" {= "1.0.1"}
+  "jst-config" {= "v0.14.1"}
   "logs" {= "0.7.0"}
   "lwt" {= "5.4.1"}
   "lwt_react" {= "1.1.4"}
@@ -90,13 +91,25 @@ depends: [
   "ocplib-endian" {= "1.1"}
   "ocplib-json-typed" {= "0.7.1"}
   "ocplib-json-typed-browser" {= "0.7.1"}
+  "octavius" {= "1.2.2"}
   "odoc" {= "1.5.3"}
   "omd" {= "1.3.1"}
   "optint" {= "0.1.0"}
   "parsexp" {= "v0.14.1"}
   "pprint" {= "20200410"}
+  "ppx_assert" {= "v0.14.0"}
+  "ppx_base" {= "v0.14.0"}
+  "ppx_cold" {= "v0.14.0"}
+  "ppx_compare" {= "v0.14.0"}
   "ppx_cstruct" {= "5.0.0"}
   "ppx_derivers" {= "1.2.1"}
+  "ppx_enumerate" {= "v0.14.0"}
+  "ppx_expect" {= "v0.14.0"}
+  "ppx_hash" {= "v0.14.0"}
+  "ppx_here" {= "v0.14.0"}
+  "ppx_inline_test" {= "v0.14.1"}
+  "ppx_js_style" {= "v0.14.1"}
+  "ppx_optcomp" {= "v0.14.0"}
   "ppx_sexp_conv" {= "v0.14.1"}
   "ppx_tools" {= "6.3"}
   "ppx_tools_versioned" {= "5.4.0"}
@@ -109,8 +122,10 @@ depends: [
   "sexplib" {= "v0.14.0"}
   "sexplib0" {= "v0.14.0"}
   "ssl" {= "0.5.12"}
+  "stdio" {= "v0.14.0"}
   "stdlib-shims" {= "0.3.0"}
   "stringext" {= "1.6.0"}
+  "time_now" {= "v0.14.0"}
   "topkg" {= "1.0.3"}
   "tyxml" {= "4.4.0"}
   "uchar" {= "0.0.2"}
@@ -123,6 +138,7 @@ depends: [
 build: [
   [make "static"]
   ["dune" "build" "-p" name "-j" jobs]
+  [make "detect-libs"] {with-test}
 ]
 install: [
   ["mkdir" "-p" "%{_:share}%"]
@@ -133,3 +149,4 @@ description: """
 This contains the binaries forming the engine for the learn-ocaml platform, and
 the common files. A demo exercise repository is also provided as example.
 """
+run-test: [make "test"]
diff --git a/src/app/learnocaml_teacher_tab.ml b/src/app/learnocaml_teacher_tab.ml
@@ -299,13 +299,13 @@ 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"]
+                  | GloballyInconsistent -> "exo_closed", [%i"Inconsistent"]
                 in
                 H.span ~a:[H.a_class [cls]] [H.txt text]
               ];
@@ -856,17 +856,13 @@ 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
+                   || open_assg = ES.GloballyInconsistent)
                 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 +1326,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

diff --git a/src/state/dune b/src/state/dune
@@ -15,6 +15,15 @@
             learnocaml_repository)
 )
 
+(library
+  (name learnocaml_data_test)
+  (wrapped false)
+  (modules Learnocaml_data_test)
+  (libraries learnocaml_data)
+  (inline_tests)
+  (preprocess (pps ppx_expect ppx_inline_test))
+)
+
 (library
  (name learnocaml_api)
  (wrapped false)

diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml
@@ -508,11 +508,126 @@ 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" *)
+      | GloballyInconsistent     (** "Inconsistent" *)
+
+    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 ?(close=true) a =
+      if close then
+        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
+      else
+        let mp =
+          Token.Map.map (function Closed -> Open | st -> st) a.token_map in
+        match a.default with
+        | Open | Closed ->
+           make_assignments mp Open
+        | 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
+      | Assigned _ ->
+         let o, c =
+           Token.Map.fold (fun _tok st (o, c) ->
+               (o || st = Open,
+                c || st = Closed)) a.token_map (false, false) in
+         begin match o, c with
+         | true, true -> GloballyInconsistent
+         | true, false -> GloballyOpenOrAssigned
+         | false, _ -> GloballyClosedOrAssigned
+         end
+      | Open ->
+         let d, c =
+           Token.Map.fold (fun _tok st (d, c) ->
+               (d || (match st with Assigned _ -> true | _ -> false),
+                c || st = Closed)) a.token_map (false, false) in
+         begin match d, c with
+         | _, true -> GloballyInconsistent
+         | true, false -> GloballyOpenOrAssigned
+         | false, false -> GloballyOpen
+         end
+      | Closed ->
+         let d, o =
+           Token.Map.fold (fun _tok st (d, o) ->
+               (d || (match st with Assigned _ -> true | _ -> false),
+                o || st = Open)) a.token_map (false, false) in
+         begin match d, o with
+         | _, true -> GloballyInconsistent
+         | true, false -> GloballyClosedOrAssigned
+         | false, false -> GloballyClosed
+         end
+
+    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
+      | GloballyInconsistent -> fix_open_close ~close:true 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
+      | GloballyInconsistent -> fix_open_close ~close:false 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 +755,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 [