From a026374e20df36c85a7375e49364bc276241d1aa Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 20 Apr 2023 10:54:20 +0200 Subject: [PATCH 01/26] feat: dropdown menu --- src/app/learnocaml_partition_view.ml | 2 ++ static/partition-view.html | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index e0d421639..617a814bc 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -181,6 +181,8 @@ let main () = init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); + Manip.Ev.onclick (find_component "Hide tokens") + (fun _ -> alert "Hello" ; true); Lwt.return_unit let () = run_async_with_log main diff --git a/static/partition-view.html b/static/partition-view.html index 1ab9e773b..dc5ae1b7b 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -40,6 +40,10 @@
From 41886a51981a665acf789e25cd6163645b780e5d Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 20 Apr 2023 12:33:25 +0200 Subject: [PATCH 02/26] feat: dynamic implmentation --- src/app/learnocaml_partition_view.ml | 18 ++++++++++++++---- src/utils/js_utils.ml | 3 +++ 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 617a814bc..e1d6bd0bd 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -34,11 +34,23 @@ let open_tok tok = let _win = window_open ("/student-view.html?token="^tok) "_blank" in false +let list_of_nick = + List.map @@ fun x -> + let tok = Token.to_string x in + let nick = "toto" in (*trouver comment récupérer les pseudos*) + H.a ~a:[H.a_onclick (fun _ -> open_tok tok)] [H.txt (nick ^ " ")] + let list_of_tok = List.map @@ fun x -> let tok = Token.to_string x in H.a ~a:[H.a_onclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] +let right_list = + let choice = Manip.HTMLElement.select (find_component "Hide tokens") + in match choice with + |"nicknames" -> list_of_nick + |"tokens" -> list_of_tok + let rec render_tree = let open Asak.Wtree in function @@ -98,8 +110,8 @@ let exercises_tab part = part.partition_by_grade in string_of_int s ^ " codes implemented the function with the right type." in - H.p (H.txt not_graded :: list_of_tok part.not_graded) - :: H.p ( H.txt bad_type :: list_of_tok part.bad_type) + H.p (H.txt not_graded :: right_list part.not_graded) + :: H.p ( H.txt bad_type :: right_list part.bad_type) :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade @@ -181,8 +193,6 @@ let main () = init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); - Manip.Ev.onclick (find_component "Hide tokens") - (fun _ -> alert "Hello" ; true); Lwt.return_unit let () = run_async_with_log main diff --git a/src/utils/js_utils.ml b/src/utils/js_utils.ml index 6d0ee3e58..b0cee3529 100644 --- a/src/utils/js_utils.ml +++ b/src/utils/js_utils.ml @@ -459,6 +459,9 @@ module Manip = struct let title elt = let elt = get_elt "HTMLElement.title" elt in Js.to_string (elt##.title) + let select elt = + let elt = get_elt "HTMLElement.select" elt in + Js.to_string (elt##.select) end module SetHTMLElement = struct From 88dec1615a55eaa8baacb0c239db17105dbf4800 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 20 Apr 2023 15:07:50 +0200 Subject: [PATCH 03/26] feat: dynamic implementation --- src/app/learnocaml_partition_view.ml | 2 +- src/utils/js_utils.ml | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index e1d6bd0bd..cb573f99d 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -46,7 +46,7 @@ let list_of_tok = H.a ~a:[H.a_onclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] let right_list = - let choice = Manip.HTMLElement.select (find_component "Hide tokens") + let choice = Manip.value (find_component "Hide tokens") in match choice with |"nicknames" -> list_of_nick |"tokens" -> list_of_tok diff --git a/src/utils/js_utils.ml b/src/utils/js_utils.ml index b0cee3529..6d0ee3e58 100644 --- a/src/utils/js_utils.ml +++ b/src/utils/js_utils.ml @@ -459,9 +459,6 @@ module Manip = struct let title elt = let elt = get_elt "HTMLElement.title" elt in Js.to_string (elt##.title) - let select elt = - let elt = get_elt "HTMLElement.select" elt in - Js.to_string (elt##.select) end module SetHTMLElement = struct From c3f204f01a49de77efe535e503cbcffcc30ab34d Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 20 Apr 2023 17:45:36 +0200 Subject: [PATCH 04/26] feat: hide tokens --- src/app/learnocaml_partition_view.ml | 37 +++++++++++++++++++++------- 1 file changed, 28 insertions(+), 9 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index cb573f99d..80cac4b95 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -15,7 +15,6 @@ open Learnocaml_common module H = Tyxml_js.Html5 module React = Lwt_react - let find_tab name = (find_component ("learnocaml-exo-tab-" ^ name)) let tab_select_signal, init_tab, select_tab = @@ -34,7 +33,7 @@ let open_tok tok = let _win = window_open ("/student-view.html?token="^tok) "_blank" in false -let list_of_nick = +(* let list_of_nick = List.map @@ fun x -> let tok = Token.to_string x in let nick = "toto" in (*trouver comment récupérer les pseudos*) @@ -43,13 +42,18 @@ let list_of_nick = let list_of_tok = List.map @@ fun x -> let tok = Token.to_string x in - H.a ~a:[H.a_onclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] + H.a ~a:[H.a_onclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] *) -let right_list = - let choice = Manip.value (find_component "Hide tokens") +let selected_list = + List.map @@ fun x -> + let tok = Token.to_string x in + let choice = Manip.value (find_component "Hide tokens") in match choice with - |"nicknames" -> list_of_nick - |"tokens" -> list_of_tok + |"tokens" -> + H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] + |"nicknames" -> + let nick = "toto" in (*trouver comment récupérer les pseudos*) + H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (nick ^ " ")] let rec render_tree = let open Asak.Wtree in @@ -110,8 +114,8 @@ let exercises_tab part = part.partition_by_grade in string_of_int s ^ " codes implemented the function with the right type." in - H.p (H.txt not_graded :: right_list part.not_graded) - :: H.p ( H.txt bad_type :: right_list part.bad_type) + H.p (H.txt not_graded :: selected_list part.not_graded) + :: H.p ( H.txt bad_type :: selected_list part.bad_type) :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade @@ -130,6 +134,19 @@ let _class_selection_updater = true in let to_li tok repr p = let strtok = Token.to_string tok in + + (* let choice = Manip.value (find_component "Hide tokens") + in match choice with + |"tokens" -> H.li + ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] + [H.txt strtok; p] + |"nicknames" -> + let nick = "toto" in (*trouver comment récupérer les pseudos*) + H.li + ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] + [H.txt nick; p] + in *) + H.li ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] [H.txt strtok; p] in @@ -193,6 +210,8 @@ let main () = init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); + Manip.Ev.onchange_select (find_component "Hide tokens") + (fun _ -> update_repr_code (React.S.value selected_repr_signal)); Lwt.return_unit let () = run_async_with_log main From 3b68d8063ed689f138f8ae5dbedd8b52ba175f97 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Fri, 21 Apr 2023 14:55:33 +0200 Subject: [PATCH 05/26] feat: retrieve students data --- src/app/learnocaml_partition_view.ml | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 80cac4b95..1f8f4c7c0 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -44,15 +44,15 @@ let list_of_tok = let tok = Token.to_string x in H.a ~a:[H.a_onclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] *) -let selected_list = +let selected_list students= List.map @@ fun x -> let tok = Token.to_string x in - let choice = Manip.value (find_component "Hide tokens") - in match choice with + let choice = Manip.value (find_component "Hide tokens") in + match choice with |"tokens" -> H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] |"nicknames" -> - let nick = "toto" in (*trouver comment récupérer les pseudos*) + let nick = students.nickname in (*trouver comment récupérer les pseudos*) H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (nick ^ " ")] let rec render_tree = @@ -96,7 +96,7 @@ let render_classes xs = let sum_with f = List.fold_left (fun acc x -> acc + f x) 0 -let exercises_tab part = +let exercises_tab students part= let open Partition in let not_graded = string_of_int (List.length part.not_graded) @@ -114,8 +114,8 @@ let exercises_tab part = part.partition_by_grade in string_of_int s ^ " codes implemented the function with the right type." in - H.p (H.txt not_graded :: selected_list part.not_graded) - :: H.p ( H.txt bad_type :: selected_list part.bad_type) + H.p (H.txt not_graded :: selected_list students part.not_graded) + :: H.p ( H.txt bad_type :: selected_list students part.bad_type) :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade @@ -205,8 +205,10 @@ let main () = retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) >>= fun part -> - hide_loading ~id:"learnocaml-exo-loading" (); - Manip.replaceChildren (find_tab "list") (exercises_tab part); + hide_loading ~id:"learnocaml-exo-loading" (); + let students = retrieve (Learnocaml_api.Students_list (teacher_token)) in + (*>>= fun students ->*) + Manip.replaceChildren (find_tab "list") (exercises_tab students part); init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); From 126b9633939dbb78c298443a69ef88ebe7b29083 Mon Sep 17 00:00:00 2001 From: Plictox <77079482+Plictox@users.noreply.github.com> Date: Mon, 24 Apr 2023 16:26:06 +0200 Subject: [PATCH 06/26] feat: hide PII feature Co-authored-by: Erik Martin-Dorel --- static/partition-view.html | 1 + 1 file changed, 1 insertion(+) diff --git a/static/partition-view.html b/static/partition-view.html index dc5ae1b7b..c2c7c8a25 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -41,6 +41,7 @@ Learn OCaml From d558618b819ad0795e3a4929824b2539d2396f3e Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Mon, 24 Apr 2023 17:15:57 +0200 Subject: [PATCH 07/26] feat: corrections --- src/app/learnocaml_partition_view.ml | 35 ++++++++++++++++++---------- static/partition-view.html | 2 +- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 1f8f4c7c0..6ae40ff4a 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -44,16 +44,17 @@ let list_of_tok = let tok = Token.to_string x in H.a ~a:[H.a_onclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] *) -let selected_list students= - List.map @@ fun x -> +let selected_list = + List.map @@ fun s x -> let tok = Token.to_string x in - let choice = Manip.value (find_component "Hide tokens") in + let choice = Manip.value (find_component "learnocaml-select-student-info") in match choice with |"tokens" -> H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] |"nicknames" -> - let nick = students.nickname in (*trouver comment récupérer les pseudos*) + let nick = s.nickname in (*trouver comment récupérer les pseudos*) H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (nick ^ " ")] + |_ -> failwith "Error" (*à modifier*) let rec render_tree = let open Asak.Wtree in @@ -135,7 +136,7 @@ let _class_selection_updater = let to_li tok repr p = let strtok = Token.to_string tok in - (* let choice = Manip.value (find_component "Hide tokens") + (* let choice = Manip.value (find_component "learnocaml-select-student-info") in match choice with |"tokens" -> H.li ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] @@ -202,17 +203,27 @@ let main () = if tab = "answer" then update_repr_code id else true in - - retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) - >>= fun part -> - hide_loading ~id:"learnocaml-exo-loading" (); - let students = retrieve (Learnocaml_api.Students_list (teacher_token)) in - (*>>= fun students ->*) + + let fetch_students = + retrieve (Learnocaml_api.Students_list teacher_token) + >>= (fun students_map -> + let students = students_map; + Lwt.return_unit) + in + print_string(students); + let fetch_part = + retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) + >>= (fun partition -> + let part = partition; + Lwt.return_unit) + in + Lwt.join [fetch_students; fetch_part] >>= fun () -> + hide_loading ~id:"learnocaml-exo-loading" (); Manip.replaceChildren (find_tab "list") (exercises_tab students part); init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); - Manip.Ev.onchange_select (find_component "Hide tokens") + Manip.Ev.onchange_select (find_component "learnocaml-select-student-info") (fun _ -> update_repr_code (React.S.value selected_repr_signal)); Lwt.return_unit diff --git a/static/partition-view.html b/static/partition-view.html index dc5ae1b7b..a81a0b25f 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -40,7 +40,7 @@
From a7a8c90cc3c52cac46a214413444c5fbb1bd97f0 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 26 Apr 2023 12:44:48 +0200 Subject: [PATCH 11/26] feat: first working implementation --- src/app/learnocaml_partition_view.ml | 79 +++++++++++++--------------- src/state/learnocaml_data.ml | 2 +- static/css/learnocaml_common.css | 13 ++++- 3 files changed, 49 insertions(+), 45 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index a0e0fb780..fd2652df8 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -116,17 +116,20 @@ let exercises_tab part= :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade -let students_details part = - let open Partition in - let rec create_div tokens id = match tokens with +let students_details students = + let open Student in + let rec create_div students_list id = match students_list with | [] -> [] - | t::q -> let tok = Token.to_string t in - let anon_id = H.div ~a:[H.a_class["anon-id"]] [H.txt(string_of_int id)] in - let token_id = H.div ~a:[H.a_class["token-id"]] [H.txt tok] in - let nickname_id = H.div ~a:[H.a_class["nickname-id"]] [H.txt "toto" ] in (* mettre pseudo ici *) - H.div [anon_id; token_id; nickname_id] :: (create_div q (id + 1)) - in create_div part.not_graded 1 @ create_div part.bad_type (1 + List.length part.not_graded) - + | t::q -> let tok = Token.to_string t.token in + let nick = Option.value t.nickname ~default:"Student" in + H.div ~a:[ + H.a_class ["student"]; + H.a_user_data "anon" ("Student " ^ string_of_int id); + H.a_user_data "token" tok; + H.a_user_data "nickname" nick; + ] [] + :: (create_div q (id + 1)) + in create_div students 1 let _class_selection_updater = let previous = ref None in @@ -143,19 +146,6 @@ let _class_selection_updater = true in let to_li tok repr p = let strtok = Token.to_string tok in - - (* let choice = Manip.value (find_component "learnocaml-select-student-info") - in match choice with - |"tokens" -> H.li - ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] - [H.txt strtok; p] - |"nickname" -> - let nick = "toto" in (*trouver comment récupérer les pseudos*) - H.li - ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] - [H.txt nick; p] - in *) - H.li ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] [H.txt strtok; p] in @@ -174,6 +164,16 @@ let _class_selection_updater = Manip.replaceChildren (find_tab "details") [H.ul @@ mkfirst (List.hd xs) :: List.map mkelem (List.tl xs)] +let set_classes s = + Manip.removeClass (find_tab "list") ("token-id"); + Manip.removeClass (find_tab "list") ("anon-id"); + Manip.removeClass (find_tab "list") ("nickname-id"); + Manip.removeClass (find_tab "details") ("token-id"); + Manip.removeClass (find_tab "details") ("anon-id"); + Manip.removeClass (find_tab "details") ("nickname-id"); + Manip.addClass (find_tab "list") (s ^ "-id"); + Manip.addClass (find_tab "details") (s ^ "-id");true + let main () = Learnocaml_local_storage.init (); (match Js_utils.get_lang() with Some l -> Ocplib_i18n.set_lang l | None -> ()); @@ -211,34 +211,29 @@ let main () = if tab = "answer" then update_repr_code id else true in - - (* let fetch_students = + + let fetch_students = retrieve (Learnocaml_api.Students_list teacher_token) - >>= (fun students_map -> - let students = students_map; - Lwt.return_unit) + >>= fun students_map -> + let students = students_map in + Lwt.return students in - print_string(students); - let fetch_part = *) + let fetch_part = retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) - >>= fun part -> - (* Lwt.join [fetch_students; fetch_part] >>= fun () -> *) + >>= fun partition -> + let part = partition in + Lwt.return part + in + Lwt.both fetch_students fetch_part >>= fun (students, part) -> hide_loading ~id:"learnocaml-exo-loading" (); - Manip.replaceChildren (find_tab "list") (exercises_tab part); - Manip.replaceChildren (find_tab "list") (students_details part); + Manip.replaceChildren (find_tab "list") + (List.concat[exercises_tab part; students_details students]); init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); Manip.Ev.onchange_select (find_component "learnocaml-select-student-info") (fun _ ->let choice = Manip.value (find_component "learnocaml-select-student-info") in - match choice with - |"nickname" -> Manip.addClass (find_tab "list") "nickname-id"; - Manip.addClass (find_tab "details") "nickname-id";true - |"token" -> Manip.addClass (find_tab "list") "token-id"; - Manip.addClass (find_tab "details") "token-id";true - |"anon" -> Manip.addClass (find_tab "list") "anon-id"; - Manip.addClass (find_tab "details") "anon-id";true - |_ -> failwith "Wrong selection" + set_classes choice ); Lwt.return_unit diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index e92a37dbf..236b413a3 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -280,7 +280,7 @@ module Student = struct results: (float * int option) SMap.t; creation_date: float; tags: SSet.t; - } + } let enc = let open Json_encoding in diff --git a/static/css/learnocaml_common.css b/static/css/learnocaml_common.css index 9527a8284..6bc803483 100644 --- a/static/css/learnocaml_common.css +++ b/static/css/learnocaml_common.css @@ -15,10 +15,19 @@ code, pre, textarea { line-height: 18px; } -.nickname-id, .token-id { - display: none; +div.anon-id div.student::before { + content: attr(data-anon); } +div.token-id div.student::before { + content: attr(data-token); +} + +div.nickname-id div.student::before { + content: attr(data-nickname); +} + + /* -------------------- fix browser's CSSs ------------------------ */ button > img { vertical-align: -10%; From 8c2e3e5b300a1df80f49dd4eecdf87b218d4d426 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 26 Apr 2023 16:48:08 +0200 Subject: [PATCH 12/26] feat: better implementation --- src/app/learnocaml_partition_view.ml | 60 ++++++++++++++++------------ static/css/learnocaml_common.css | 6 +-- 2 files changed, 38 insertions(+), 28 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index fd2652df8..e7fa79864 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -12,6 +12,7 @@ open Js_utils open Lwt open Learnocaml_data open Learnocaml_common +open List module H = Tyxml_js.Html5 module React = Lwt_react @@ -47,11 +48,6 @@ let selected_list = |_ -> failwith "Error" (*à modifier*) *) -let list_of_tok = - List.map @@ fun x -> - let tok = Token.to_string x in - H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] - let rec render_tree = let open Asak.Wtree in function @@ -93,7 +89,36 @@ let render_classes xs = let sum_with f = List.fold_left (fun acc x -> acc + f x) 0 -let exercises_tab part= +let rec students_partition students part = + let open Student in + match part with + |[] -> [] + |t::q -> let student_t = List.find (fun student -> student.token = t) students in + student_t :: students_partition students q + +let list_of_students_details students part= + let open Student in + let open Partition in + let bad_type_students = students_partition students part.bad_type in + let not_graded_students = students_partition students part.not_graded in + let rec create_div students_list id = match students_list with + | [] -> [] + | t::q -> let tok = Token.to_string t.token in + let nick = Option.value t.nickname ~default:"Student" in + H.a ~a:[ + H.a_ondblclick (fun _ -> open_tok tok); + H.a_class ["student"]; + H.a_user_data "anon" ("Student " ^ string_of_int id ^ " "); + H.a_user_data "token" (tok ^ " "); + H.a_user_data "nickname" (nick ^ " "); + (* i added the spaces here in the attribute, + for now i don't see how to do it otherwise*) + ] [] + :: (create_div q (id + 1)) + in (create_div not_graded_students 1, + create_div bad_type_students (1 + List.length not_graded_students)) + +let exercises_tab students part = let open Partition in let not_graded = string_of_int (List.length part.not_graded) @@ -111,26 +136,12 @@ let exercises_tab part= part.partition_by_grade in string_of_int s ^ " codes implemented the function with the right type." in - H.p (H.txt not_graded :: list_of_tok part.not_graded) - :: H.p ( H.txt bad_type :: list_of_tok part.bad_type) + let (a,b) = list_of_students_details students part in + H.p (H.txt not_graded :: a) + :: H.p ( H.txt bad_type :: b) :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade -let students_details students = - let open Student in - let rec create_div students_list id = match students_list with - | [] -> [] - | t::q -> let tok = Token.to_string t.token in - let nick = Option.value t.nickname ~default:"Student" in - H.div ~a:[ - H.a_class ["student"]; - H.a_user_data "anon" ("Student " ^ string_of_int id); - H.a_user_data "token" tok; - H.a_user_data "nickname" nick; - ] [] - :: (create_div q (id + 1)) - in create_div students 1 - let _class_selection_updater = let previous = ref None in let of_repr repr = [H.code [H.txt repr]] in @@ -226,8 +237,7 @@ let main () = in Lwt.both fetch_students fetch_part >>= fun (students, part) -> hide_loading ~id:"learnocaml-exo-loading" (); - Manip.replaceChildren (find_tab "list") - (List.concat[exercises_tab part; students_details students]); + Manip.replaceChildren (find_tab "list") (exercises_tab students part); init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); diff --git a/static/css/learnocaml_common.css b/static/css/learnocaml_common.css index 6bc803483..ff2051d2a 100644 --- a/static/css/learnocaml_common.css +++ b/static/css/learnocaml_common.css @@ -15,15 +15,15 @@ code, pre, textarea { line-height: 18px; } -div.anon-id div.student::before { +div.anon-id a.student::before { content: attr(data-anon); } -div.token-id div.student::before { +div.token-id a.student::before { content: attr(data-token); } -div.nickname-id div.student::before { +div.nickname-id a.student::before { content: attr(data-nickname); } From c358b34801e8c8f7fa847645b6a200aa6db1c6f2 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Wed, 26 Apr 2023 16:56:19 +0200 Subject: [PATCH 13/26] feat: enhancing html page --- static/partition-view.html | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/static/partition-view.html b/static/partition-view.html index 121cc287e..c9cee3ec4 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -41,7 +41,7 @@ Learn OCaml @@ -59,8 +59,8 @@
-
-
+
+
From 32ea5e18f6b0e900fd0020d67e73f002228f1e93 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 27 Apr 2023 09:54:22 +0200 Subject: [PATCH 14/26] feat: changes from review --- src/app/learnocaml_partition_view.ml | 25 ++++--------------------- src/state/learnocaml_data.ml | 2 +- static/partition-view.html | 6 +++--- 3 files changed, 8 insertions(+), 25 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index e7fa79864..48d1da060 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -12,7 +12,6 @@ open Js_utils open Lwt open Learnocaml_data open Learnocaml_common -open List module H = Tyxml_js.Html5 module React = Lwt_react @@ -34,20 +33,6 @@ let open_tok tok = let _win = window_open ("/student-view.html?token="^tok) "_blank" in false -(* -let selected_list = - List.map @@ fun x -> - let tok = Token.to_string x in - let choice = Manip.value (find_component "learnocaml-select-student-info") in - match choice with - |"tokens" -> - H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (tok ^ " ")] - |"nickname" -> - let nick = "toto" in (*trouver comment récupérer les pseudos*) - H.a ~a:[H.a_ondblclick (fun _ -> open_tok tok)] [H.txt (nick ^ " ")] - |_ -> failwith "Error" (*à modifier*) - *) - let rec render_tree = let open Asak.Wtree in function @@ -136,9 +121,9 @@ let exercises_tab students part = part.partition_by_grade in string_of_int s ^ " codes implemented the function with the right type." in - let (a,b) = list_of_students_details students part in - H.p (H.txt not_graded :: a) - :: H.p ( H.txt bad_type :: b) + let (not_graded_students,bad_type_students) = list_of_students_details students part in + H.p (H.txt not_graded :: not_graded_students) + :: H.p ( H.txt bad_type :: bad_type_students) :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade @@ -242,9 +227,7 @@ let main () = Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); Manip.Ev.onchange_select (find_component "learnocaml-select-student-info") - (fun _ ->let choice = Manip.value (find_component "learnocaml-select-student-info") in - set_classes choice - ); + (fun _ -> find_component "learnocaml-select-student-info" |> Manip.value |> set_classes); Lwt.return_unit let () = run_async_with_log main diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 236b413a3..e92a37dbf 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -280,7 +280,7 @@ module Student = struct results: (float * int option) SMap.t; creation_date: float; tags: SSet.t; - } + } let enc = let open Json_encoding in diff --git a/static/partition-view.html b/static/partition-view.html index c9cee3ec4..2531a626c 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -41,8 +41,8 @@ Learn OCaml
@@ -59,7 +59,7 @@
-
+
From f4fdd8fd724f7b80ad29af573a18d2b2ee38208b Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 27 Apr 2023 10:32:52 +0200 Subject: [PATCH 15/26] feat: useless code deleted --- src/app/learnocaml_partition_view.ml | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 48d1da060..696634629 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -208,17 +208,9 @@ let main () = then update_repr_code id else true in - let fetch_students = - retrieve (Learnocaml_api.Students_list teacher_token) - >>= fun students_map -> - let students = students_map in - Lwt.return students - in - let fetch_part = + let fetch_students = retrieve (Learnocaml_api.Students_list teacher_token) in + let fetch_part = retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) - >>= fun partition -> - let part = partition in - Lwt.return part in Lwt.both fetch_students fetch_part >>= fun (students, part) -> hide_loading ~id:"learnocaml-exo-loading" (); From c1f2f2fa6082ad70f83d4f43956ea7817bd24b13 Mon Sep 17 00:00:00 2001 From: Plictox <77079482+Plictox@users.noreply.github.com> Date: Thu, 27 Apr 2023 10:34:52 +0200 Subject: [PATCH 16/26] feat: changing variable names Co-authored-by: Erik Martin-Dorel --- src/app/learnocaml_partition_view.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 696634629..ab06aace7 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -160,15 +160,15 @@ let _class_selection_updater = Manip.replaceChildren (find_tab "details") [H.ul @@ mkfirst (List.hd xs) :: List.map mkelem (List.tl xs)] -let set_classes s = +let set_classes selected = Manip.removeClass (find_tab "list") ("token-id"); Manip.removeClass (find_tab "list") ("anon-id"); Manip.removeClass (find_tab "list") ("nickname-id"); Manip.removeClass (find_tab "details") ("token-id"); Manip.removeClass (find_tab "details") ("anon-id"); Manip.removeClass (find_tab "details") ("nickname-id"); - Manip.addClass (find_tab "list") (s ^ "-id"); - Manip.addClass (find_tab "details") (s ^ "-id");true + Manip.addClass (find_tab "list") (selected ^ "-id"); + Manip.addClass (find_tab "details") (selected ^ "-id"); true let main () = Learnocaml_local_storage.init (); From 1d3abf4ae703c2f1006b3a61b14eabc9cba6d63a Mon Sep 17 00:00:00 2001 From: Plictox <77079482+Plictox@users.noreply.github.com> Date: Thu, 27 Apr 2023 10:37:45 +0200 Subject: [PATCH 17/26] feat: improved list_of_students_details Co-authored-by: Erik Martin-Dorel --- src/app/learnocaml_partition_view.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index ab06aace7..2d0090331 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -81,7 +81,10 @@ let rec students_partition students part = |t::q -> let student_t = List.find (fun student -> student.token = t) students in student_t :: students_partition students q -let list_of_students_details students part= +let list_of_students_details students part = + let students = + List.fold_left (fun res st -> Token.Map.add st.Student.token st res) + Token.Map.empty students in let open Student in let open Partition in let bad_type_students = students_partition students part.bad_type in From 7d142b283e392bbb8b73488481a9454155033808 Mon Sep 17 00:00:00 2001 From: Plictox <77079482+Plictox@users.noreply.github.com> Date: Thu, 27 Apr 2023 10:38:10 +0200 Subject: [PATCH 18/26] feat: improved students_partition Co-authored-by: Erik Martin-Dorel --- src/app/learnocaml_partition_view.ml | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 2d0090331..3015cfe67 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -74,12 +74,8 @@ let render_classes xs = let sum_with f = List.fold_left (fun acc x -> acc + f x) 0 -let rec students_partition students part = - let open Student in - match part with - |[] -> [] - |t::q -> let student_t = List.find (fun student -> student.token = t) students in - student_t :: students_partition students q +let students_partition (students : Student.t Token.Map.t) part = + List.map (fun t -> Token.Map.find t students) part let list_of_students_details students part = let students = From 5c3a045327a01888b698a5ae9e1601fb50ccb2e4 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 27 Apr 2023 10:49:19 +0200 Subject: [PATCH 19/26] feat: changing default selection --- static/partition-view.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/static/partition-view.html b/static/partition-view.html index 2531a626c..3941f7110 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -60,7 +60,7 @@
-
+
From 9f2c2a6717b287d754d32612915cba44000aad44 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 27 Apr 2023 15:03:22 +0200 Subject: [PATCH 20/26] feat: implementation for the details tab --- src/app/learnocaml_partition_view.ml | 49 +++++++++++++++++++--------- static/css/learnocaml_common.css | 10 +++--- 2 files changed, 40 insertions(+), 19 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 3015cfe67..d896154a2 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -74,13 +74,13 @@ let render_classes xs = let sum_with f = List.fold_left (fun acc x -> acc + f x) 0 -let students_partition (students : Student.t Token.Map.t) part = - List.map (fun t -> Token.Map.find t students) part - -let list_of_students_details students part = - let students = +let students_partition students part = + let students_map = List.fold_left (fun res st -> Token.Map.add st.Student.token st res) Token.Map.empty students in + List.map (fun t -> Token.Map.find t students_map) part + +let list_of_students_details students part = let open Student in let open Partition in let bad_type_students = students_partition students part.bad_type in @@ -96,7 +96,7 @@ let list_of_students_details students part = H.a_user_data "token" (tok ^ " "); H.a_user_data "nickname" (nick ^ " "); (* i added the spaces here in the attribute, - for now i don't see how to do it otherwise*) + for now i don't see how to do otherwise*) ] [] :: (create_div q (id + 1)) in (create_div not_graded_students 1, @@ -126,6 +126,12 @@ let exercises_tab students part = :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade +let replace_with_students xs students = + let students_map = + List.fold_left (fun res st -> Token.Map.add st.Student.token st res) + Token.Map.empty students in + List.map (fun (tok,repr) -> (Token.Map.find tok students_map,repr)) xs + let _class_selection_updater = let previous = ref None in let of_repr repr = [H.code [H.txt repr]] in @@ -139,25 +145,38 @@ let _class_selection_updater = Manip.replaceChildren p (of_repr repr); set_selected_repr (Some (tok,repr)); true in - let to_li tok repr p = + let to_li student repr p = + let tok = student.Student.token in + let nick = Option.value student.Student.nickname ~default:"Student" in let strtok = Token.to_string tok in H.li - ~a:[ onclick p tok repr ; H.a_ondblclick (fun _ -> open_tok strtok)] - [H.txt strtok; p] in - let mkfirst (tok,repr) = + ~a:[ onclick p tok repr ; + H.a_ondblclick (fun _ -> open_tok strtok); + H.a_class ["student"]; + H.a_user_data "anon" ("Student"); + H.a_user_data "token" (strtok); + H.a_user_data "nickname" (nick); + ] + [H.txt ""; p] in + let mkfirst (students,repr) = let p = H.p (of_repr repr) in previous := Some p; - to_li tok repr p in - let mkelem (tok,repr) = - to_li tok repr @@ H.p [] + to_li students repr p in + let mkelem (student,repr) = + to_li student repr @@ H.p [] in selected_class_signal |> React.S.map @@ fun id -> match id with - | None -> () + | None -> Lwt.return_unit | Some xs -> set_selected_repr (Some (List.hd xs)); + let teacher_token = Learnocaml_local_storage.(retrieve sync_token) in + retrieve (Learnocaml_api.Students_list teacher_token) + >>= fun students -> + let xs = replace_with_students xs students in Manip.replaceChildren (find_tab "details") - [H.ul @@ mkfirst (List.hd xs) :: List.map mkelem (List.tl xs)] + [H.ul @@ mkfirst (List.hd xs) :: List.map mkelem (List.tl xs)]; + Lwt.return_unit let set_classes selected = Manip.removeClass (find_tab "list") ("token-id"); diff --git a/static/css/learnocaml_common.css b/static/css/learnocaml_common.css index ff2051d2a..0c19b3af4 100644 --- a/static/css/learnocaml_common.css +++ b/static/css/learnocaml_common.css @@ -15,19 +15,21 @@ code, pre, textarea { line-height: 18px; } -div.anon-id a.student::before { +div.anon-id a.student::before, +div.anon-id li.student::before { content: attr(data-anon); } -div.token-id a.student::before { +div.token-id a.student::before, +div.token-id li.student::before { content: attr(data-token); } -div.nickname-id a.student::before { +div.nickname-id a.student::before, +div.nickname-id li.student::before { content: attr(data-nickname); } - /* -------------------- fix browser's CSSs ------------------------ */ button > img { vertical-align: -10%; From 608301fec3827e84b26f2b3f104644dc87f49d16 Mon Sep 17 00:00:00 2001 From: Louis Tariot Date: Thu, 27 Apr 2023 15:08:36 +0200 Subject: [PATCH 21/26] feat: changing a into span --- src/app/learnocaml_partition_view.ml | 2 +- static/css/learnocaml_common.css | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index d896154a2..fda231c43 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -89,7 +89,7 @@ let list_of_students_details students part = | [] -> [] | t::q -> let tok = Token.to_string t.token in let nick = Option.value t.nickname ~default:"Student" in - H.a ~a:[ + H.span ~a:[ H.a_ondblclick (fun _ -> open_tok tok); H.a_class ["student"]; H.a_user_data "anon" ("Student " ^ string_of_int id ^ " "); diff --git a/static/css/learnocaml_common.css b/static/css/learnocaml_common.css index 0c19b3af4..78d0d4f66 100644 --- a/static/css/learnocaml_common.css +++ b/static/css/learnocaml_common.css @@ -15,17 +15,17 @@ code, pre, textarea { line-height: 18px; } -div.anon-id a.student::before, +div.anon-id span.student::before, div.anon-id li.student::before { content: attr(data-anon); } -div.token-id a.student::before, +div.token-id span.student::before, div.token-id li.student::before { content: attr(data-token); } -div.nickname-id a.student::before, +div.nickname-id span.student::before, div.nickname-id li.student::before { content: attr(data-nickname); } From d8289fd2b4d929c112b319bdcbac4b9c54460082 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Apr 2023 01:15:06 +0200 Subject: [PATCH 22/26] feat: Add learnocaml_partition_view.css --- static/css/learnocaml_partition_view.css | 14 ++++++++++++++ static/partition-view.html | 3 ++- 2 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 static/css/learnocaml_partition_view.css diff --git a/static/css/learnocaml_partition_view.css b/static/css/learnocaml_partition_view.css new file mode 100644 index 000000000..45e934ee7 --- /dev/null +++ b/static/css/learnocaml_partition_view.css @@ -0,0 +1,14 @@ +#learnocaml-select-student-info { + border-radius: 9px; + border-color: salmon; + border-style: solid; + border-width: 3px; + background-color: lightyellow; + vertical-align: middle; +} + +span.student { + border-radius: 5px; + background-color: lightyellow; + cursor: pointer; +} diff --git a/static/partition-view.html b/static/partition-view.html index 3941f7110..3f4b02074 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -6,7 +6,8 @@ Learn OCaml by OCamlPro - Partition details - + + From 6b52d83aa75c4aa38671cff306b1ee7ffe7cbaf8 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Apr 2023 01:17:29 +0200 Subject: [PATCH 23/26] fix(partition-view): Fix the order of tabs in responsive mode Now: 1. "List" 2. "Details" 3. "Answer" --- static/partition-view.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/static/partition-view.html b/static/partition-view.html index 3f4b02074..764774c5e 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -53,10 +53,10 @@
+ -
From 22542b7d1950ed1dabd6d2f776ba4c69db891a33 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Apr 2023 01:23:43 +0200 Subject: [PATCH 24/26] refactor(partition-view): Turn the students_list in students_map ASAP --- src/app/learnocaml_partition_view.ml | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index fda231c43..fe2cbef3f 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -74,11 +74,8 @@ let render_classes xs = let sum_with f = List.fold_left (fun acc x -> acc + f x) 0 -let students_partition students part = - let students_map = - List.fold_left (fun res st -> Token.Map.add st.Student.token st res) - Token.Map.empty students in - List.map (fun t -> Token.Map.find t students_map) part +let students_partition students_map tokens = + List.map (fun t -> Token.Map.find t students_map) tokens let list_of_students_details students part = let open Student in @@ -102,7 +99,7 @@ let list_of_students_details students part = in (create_div not_graded_students 1, create_div bad_type_students (1 + List.length not_graded_students)) -let exercises_tab students part = +let exercises_tab students_map part = let open Partition in let not_graded = string_of_int (List.length part.not_graded) @@ -120,7 +117,8 @@ let exercises_tab students part = part.partition_by_grade in string_of_int s ^ " codes implemented the function with the right type." in - let (not_graded_students,bad_type_students) = list_of_students_details students part in + let (not_graded_students, bad_type_students) = + list_of_students_details students_map part in H.p (H.txt not_graded :: not_graded_students) :: H.p ( H.txt bad_type :: bad_type_students) :: H.p [H.txt total_sum] @@ -226,13 +224,18 @@ let main () = then update_repr_code id else true in - let fetch_students = retrieve (Learnocaml_api.Students_list teacher_token) in + let fetch_students = + retrieve (Learnocaml_api.Students_list teacher_token) + >|= fun students -> + List.fold_left (fun res st -> Token.Map.add st.Student.token st res) + Token.Map.empty students in + let fetch_part = - retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) - in - Lwt.both fetch_students fetch_part >>= fun (students, part) -> + retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) in + + Lwt.both fetch_students fetch_part >>= fun (students_map, part) -> hide_loading ~id:"learnocaml-exo-loading" (); - Manip.replaceChildren (find_tab "list") (exercises_tab students part); + Manip.replaceChildren (find_tab "list") (exercises_tab students_map part); init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); From 11d442d1033e7eae595ddf68df5f1e4dcd3e3d7e Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Apr 2023 11:02:30 +0200 Subject: [PATCH 25/26] fix: Fix `` bugs --- src/app/learnocaml_partition_view.ml | 12 ++++++++---- static/partition-view.html | 6 +++--- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index fe2cbef3f..53707ba1e 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -184,7 +184,7 @@ let set_classes selected = Manip.removeClass (find_tab "details") ("anon-id"); Manip.removeClass (find_tab "details") ("nickname-id"); Manip.addClass (find_tab "list") (selected ^ "-id"); - Manip.addClass (find_tab "details") (selected ^ "-id"); true + Manip.addClass (find_tab "details") (selected ^ "-id") let main () = Learnocaml_local_storage.init (); @@ -233,14 +233,18 @@ let main () = let fetch_part = retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) in + let select = find_component "learnocaml-select-student-info" in + + let update_pii_selected () = set_classes (Manip.value select) in + Lwt.both fetch_students fetch_part >>= fun (students_map, part) -> - hide_loading ~id:"learnocaml-exo-loading" (); Manip.replaceChildren (find_tab "list") (exercises_tab students_map part); + Manip.Ev.onchange_select select (fun _ -> update_pii_selected (); true); + update_pii_selected (); + hide_loading ~id:"learnocaml-exo-loading" (); init_tab (); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); - Manip.Ev.onchange_select (find_component "learnocaml-select-student-info") - (fun _ -> find_component "learnocaml-select-student-info" |> Manip.value |> set_classes); Lwt.return_unit let () = run_async_with_log main diff --git a/static/partition-view.html b/static/partition-view.html index 764774c5e..4ab94ee61 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -42,7 +42,7 @@ Learn OCaml @@ -60,8 +60,8 @@
-
-
+
+
From 0eddfeac829aaf56989b3fd3151c72605ff0ec5a Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 30 Apr 2023 23:11:37 +0200 Subject: [PATCH 26/26] fix: Apply review changes --- src/app/learnocaml_partition_view.ml | 150 ++++++++++++++++----------- static/partition-view.html | 6 +- 2 files changed, 95 insertions(+), 61 deletions(-) diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index 53707ba1e..d1571a151 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -15,6 +15,7 @@ open Learnocaml_common module H = Tyxml_js.Html5 module React = Lwt_react + let find_tab name = (find_component ("learnocaml-exo-tab-" ^ name)) let tab_select_signal, init_tab, select_tab = @@ -29,6 +30,10 @@ let update_answer_tab, clear_answer_tab = ace_display (find_tab "answer") let selected_class_signal, set_selected_class = React.S.create None let selected_repr_signal, set_selected_repr = React.S.create None +let students_map = ref Token.Map.empty +let anon_id_map = ref Token.Map.empty +let partition = ref None + let open_tok tok = let _win = window_open ("/student-view.html?token="^tok) "_blank" in false @@ -43,7 +48,7 @@ let rec render_tree = | Node (f,l,r) -> [ H.p [ H.txt ("Node " ^ string_of_int f) ] - ; H.ul [ + ; H.ul [ H.li (render_tree l) ; H.li (render_tree r) ] @@ -74,32 +79,59 @@ let render_classes xs = let sum_with f = List.fold_left (fun acc x -> acc + f x) 0 -let students_partition students_map tokens = - List.map (fun t -> Token.Map.find t students_map) tokens +let students_of_tokens tokens = + List.map (fun t -> Token.Map.find t !students_map) tokens + +(* implements the following, minor feature: + give a unique number foreach student involved in the partition *) +let generate_anon_from_part () = + let open Partition in + let part = Option.get !partition in + let num = ref 0 in + let count tokens = + let new_map = + List.fold_left (fun res st -> incr num; Token.Map.add st !num res) + !anon_id_map tokens in + anon_id_map := new_map in + count part.not_graded; + count part.bad_type; + let rec wcount = function + | Asak.Wtree.Node (_i, wa, wb) -> wcount wa; wcount wb + | Asak.Wtree.Leaf list_pair_tok -> count (List.map fst list_pair_tok) in + part.partition_by_grade |> List.iter @@ fun (_grade, list) -> + list |> List.iter @@ wcount + +let anon_id_of_student st = + string_of_int @@ Token.Map.find st.Student.token !anon_id_map + +let nickname_of_student st = + Option.value st.Student.nickname ~default:("Nick" ^ " N/A") -let list_of_students_details students part = - let open Student in +let list_of_students_details () = let open Partition in - let bad_type_students = students_partition students part.bad_type in - let not_graded_students = students_partition students part.not_graded in - let rec create_div students_list id = match students_list with - | [] -> [] - | t::q -> let tok = Token.to_string t.token in - let nick = Option.value t.nickname ~default:"Student" in - H.span ~a:[ - H.a_ondblclick (fun _ -> open_tok tok); - H.a_class ["student"]; - H.a_user_data "anon" ("Student " ^ string_of_int id ^ " "); - H.a_user_data "token" (tok ^ " "); - H.a_user_data "nickname" (nick ^ " "); - (* i added the spaces here in the attribute, - for now i don't see how to do otherwise*) - ] [] - :: (create_div q (id + 1)) - in (create_div not_graded_students 1, - create_div bad_type_students (1 + List.length not_graded_students)) - -let exercises_tab students_map part = + let part = Option.get !partition in + let not_graded_students = students_of_tokens part.not_graded in + let bad_type_students = students_of_tokens part.bad_type in + let create_div students_list = + students_list |> + List.concat_map @@ + fun st -> + let anon = anon_id_of_student st in + let nick = nickname_of_student st in + let tok = Token.to_string st.Student.token in + [H.span ~a:[ + H.a_ondblclick (fun _ -> open_tok tok); + H.a_class ["student"]; + H.a_user_data "anon" ("Student " ^ anon); + H.a_user_data "nickname" nick; + H.a_user_data "token" tok; + ] []; + H.txt " "] in + (create_div not_graded_students, + create_div bad_type_students) + +let exercises_tab () = + let part = Option.get !partition in let open Partition in let not_graded = string_of_int (List.length part.not_graded) @@ -118,22 +150,19 @@ let exercises_tab students_map part = string_of_int s ^ " codes implemented the function with the right type." in let (not_graded_students, bad_type_students) = - list_of_students_details students_map part in + list_of_students_details () in H.p (H.txt not_graded :: not_graded_students) - :: H.p ( H.txt bad_type :: bad_type_students) + :: H.p (H.txt bad_type :: bad_type_students) :: H.p [H.txt total_sum] :: render_classes part.partition_by_grade -let replace_with_students xs students = - let students_map = - List.fold_left (fun res st -> Token.Map.add st.Student.token st res) - Token.Map.empty students in - List.map (fun (tok,repr) -> (Token.Map.find tok students_map,repr)) xs +let replace_with_students xs = + List.map (fun (tok, repr) -> (Token.Map.find tok !students_map, repr)) xs let _class_selection_updater = let previous = ref None in let of_repr repr = [H.code [H.txt repr]] in - let onclick p tok repr = + let onclick p token repr = H.a_onclick @@ fun _ -> (match !previous with @@ -141,21 +170,21 @@ let _class_selection_updater = | Some prev -> Manip.replaceChildren prev []); previous := Some p; Manip.replaceChildren p (of_repr repr); - set_selected_repr (Some (tok,repr)); + set_selected_repr (Some (token, repr)); true in - let to_li student repr p = - let tok = student.Student.token in - let nick = Option.value student.Student.nickname ~default:"Student" in - let strtok = Token.to_string tok in + let to_li st repr p = + let anon = anon_id_of_student st in + let nick = nickname_of_student st in + let tok = Token.to_string st.Student.token in H.li - ~a:[ onclick p tok repr ; - H.a_ondblclick (fun _ -> open_tok strtok); - H.a_class ["student"]; - H.a_user_data "anon" ("Student"); - H.a_user_data "token" (strtok); - H.a_user_data "nickname" (nick); - ] - [H.txt ""; p] in + [H.span ~a:[ onclick p st.Student.token repr; + H.a_ondblclick (fun _ -> open_tok tok); + H.a_class ["student"]; + H.a_user_data "anon" ("Student " ^ anon); + H.a_user_data "nickname" nick; + H.a_user_data "token" tok; + ] []; + p] in let mkfirst (students,repr) = let p = H.p (of_repr repr) in previous := Some p; @@ -165,16 +194,12 @@ let _class_selection_updater = in selected_class_signal |> React.S.map @@ fun id -> match id with - | None -> Lwt.return_unit + | None -> () | Some xs -> set_selected_repr (Some (List.hd xs)); - let teacher_token = Learnocaml_local_storage.(retrieve sync_token) in - retrieve (Learnocaml_api.Students_list teacher_token) - >>= fun students -> - let xs = replace_with_students xs students in + let xs = replace_with_students xs in Manip.replaceChildren (find_tab "details") - [H.ul @@ mkfirst (List.hd xs) :: List.map mkelem (List.tl xs)]; - Lwt.return_unit + [H.ul @@ mkfirst (List.hd xs) :: List.map mkelem (List.tl xs)] let set_classes selected = Manip.removeClass (find_tab "list") ("token-id"); @@ -227,22 +252,27 @@ let main () = let fetch_students = retrieve (Learnocaml_api.Students_list teacher_token) >|= fun students -> - List.fold_left (fun res st -> Token.Map.add st.Student.token st res) - Token.Map.empty students in + let map = + List.fold_left (fun res st -> Token.Map.add st.Student.token st res) + Token.Map.empty students in + students_map := map in let fetch_part = - retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) in + retrieve (Learnocaml_api.Partition (teacher_token, exercise_id, fun_id, prof)) + >|= fun part -> + partition := Some part in let select = find_component "learnocaml-select-student-info" in let update_pii_selected () = set_classes (Manip.value select) in - Lwt.both fetch_students fetch_part >>= fun (students_map, part) -> - Manip.replaceChildren (find_tab "list") (exercises_tab students_map part); - Manip.Ev.onchange_select select (fun _ -> update_pii_selected (); true); - update_pii_selected (); + Lwt.join [fetch_students; fetch_part] >>= fun () -> + generate_anon_from_part (); hide_loading ~id:"learnocaml-exo-loading" (); + Manip.replaceChildren (find_tab "list") (exercises_tab ()); + update_pii_selected (); init_tab (); + Manip.Ev.onchange_select select (fun _ -> update_pii_selected (); true); Manip.Ev.onclick (find_component "learnocaml-exo-button-answer") (fun _ -> select_tab "answer"; update_repr_code (React.S.value selected_repr_signal)); Lwt.return_unit diff --git a/static/partition-view.html b/static/partition-view.html index 4ab94ee61..479d2cb96 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -60,7 +60,11 @@
-
+
+
+

Click on a Leaf to see details

+
+