diff --git a/demo-repository/exercises/demo-multi/demoM-exo1/descr.md b/demo-repository/exercises/demo-multi/demoM-exo1/descr.md new file mode 100644 index 000000000..13c15704a --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo1/descr.md @@ -0,0 +1,8 @@ +The following example link will open another tab/window: [OCaml](https://ocaml.org "External link") +This exercise is just another demo for the exercise environment. +Test + +
+ Hint + Use an indirection. +
diff --git a/demo-repository/exercises/demo-multi/demoM-exo1/meta.json b/demo-repository/exercises/demo-multi/demoM-exo1/meta.json new file mode 100644 index 000000000..6f1d64e8b --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo1/meta.json @@ -0,0 +1,2 @@ +{"learnocaml_version":"1","kind":"exercise","stars":0, + "title":"Demo of the exercise environment (MD version)"} diff --git a/demo-repository/exercises/demo-multi/demoM-exo1/prelude.ml b/demo-repository/exercises/demo-multi/demoM-exo1/prelude.ml new file mode 100644 index 000000000..8436a905e --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo1/prelude.ml @@ -0,0 +1,2 @@ +(* Some code is loaded in the toplevel before your code. *) +let greetings = "Hello world!" diff --git a/demo-repository/exercises/demo-multi/demoM-exo1/prepare.ml b/demo-repository/exercises/demo-multi/demoM-exo1/prepare.ml new file mode 100644 index 000000000..e69de29bb diff --git a/demo-repository/exercises/demo-multi/demoM-exo1/solution.ml b/demo-repository/exercises/demo-multi/demoM-exo1/solution.ml new file mode 100644 index 000000000..cb7e63583 --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo1/solution.ml @@ -0,0 +1,4 @@ +let plus = (+) +let times = ( * ) +let minus = ( - ) +let divide = ( / ) diff --git a/demo-repository/exercises/demo-multi/demoM-exo1/template.ml b/demo-repository/exercises/demo-multi/demoM-exo1/template.ml new file mode 100644 index 000000000..8292e5d81 --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo1/template.ml @@ -0,0 +1,6 @@ + +let plus x y = x + y ;; + +let minus x y = y - x ;; + +let times x y = x * diff --git a/demo-repository/exercises/demo-multi/demoM-exo1/test.ml b/demo-repository/exercises/demo-multi/demoM-exo1/test.ml new file mode 100644 index 000000000..91ca022bd --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo1/test.ml @@ -0,0 +1,26 @@ +open Test_lib +open Report + +let () = + set_result @@ + ast_sanity_check code_ast @@ fun () -> + [ Section + ([ Text "Function:" ; Code "plus" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "plus" + [ (1, 1) ; (2, 2) ; (10, -10) ]) ; + Section + ([ Text "Function:" ; Code "minus" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "minus" + [ (1, 1) ; (4, -2) ; (0, 10) ]) ; + Section + ([ Text "Function:" ; Code "times" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "times" + [ (1, 3) ; (2, 4) ; (3, 0) ]) ; + Section + ([ Text "Function:" ; Code "divide" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "divide" + [ (12, 4) ; (12, 5) ; (3, 0) ]) ] diff --git a/demo-repository/exercises/demo-multi/demoM-exo2/descr.md b/demo-repository/exercises/demo-multi/demoM-exo2/descr.md new file mode 100644 index 000000000..13c15704a --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo2/descr.md @@ -0,0 +1,8 @@ +The following example link will open another tab/window: [OCaml](https://ocaml.org "External link") +This exercise is just another demo for the exercise environment. +Test + +
+ Hint + Use an indirection. +
diff --git a/demo-repository/exercises/demo-multi/demoM-exo2/meta.json b/demo-repository/exercises/demo-multi/demoM-exo2/meta.json new file mode 100644 index 000000000..6f1d64e8b --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo2/meta.json @@ -0,0 +1,2 @@ +{"learnocaml_version":"1","kind":"exercise","stars":0, + "title":"Demo of the exercise environment (MD version)"} diff --git a/demo-repository/exercises/demo-multi/demoM-exo2/prelude.ml b/demo-repository/exercises/demo-multi/demoM-exo2/prelude.ml new file mode 100644 index 000000000..8436a905e --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo2/prelude.ml @@ -0,0 +1,2 @@ +(* Some code is loaded in the toplevel before your code. *) +let greetings = "Hello world!" diff --git a/demo-repository/exercises/demo-multi/demoM-exo2/prepare.ml b/demo-repository/exercises/demo-multi/demoM-exo2/prepare.ml new file mode 100644 index 000000000..e69de29bb diff --git a/demo-repository/exercises/demo-multi/demoM-exo2/solution.ml b/demo-repository/exercises/demo-multi/demoM-exo2/solution.ml new file mode 100644 index 000000000..cb7e63583 --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo2/solution.ml @@ -0,0 +1,4 @@ +let plus = (+) +let times = ( * ) +let minus = ( - ) +let divide = ( / ) diff --git a/demo-repository/exercises/demo-multi/demoM-exo2/template.ml b/demo-repository/exercises/demo-multi/demoM-exo2/template.ml new file mode 100644 index 000000000..8292e5d81 --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo2/template.ml @@ -0,0 +1,6 @@ + +let plus x y = x + y ;; + +let minus x y = y - x ;; + +let times x y = x * diff --git a/demo-repository/exercises/demo-multi/demoM-exo2/test.ml b/demo-repository/exercises/demo-multi/demoM-exo2/test.ml new file mode 100644 index 000000000..91ca022bd --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-exo2/test.ml @@ -0,0 +1,26 @@ +open Test_lib +open Report + +let () = + set_result @@ + ast_sanity_check code_ast @@ fun () -> + [ Section + ([ Text "Function:" ; Code "plus" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "plus" + [ (1, 1) ; (2, 2) ; (10, -10) ]) ; + Section + ([ Text "Function:" ; Code "minus" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "minus" + [ (1, 1) ; (4, -2) ; (0, 10) ]) ; + Section + ([ Text "Function:" ; Code "times" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "times" + [ (1, 3) ; (2, 4) ; (3, 0) ]) ; + Section + ([ Text "Function:" ; Code "divide" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "divide" + [ (12, 4) ; (12, 5) ; (3, 0) ]) ] diff --git a/demo-repository/exercises/demo-multi/demoM-prof/descr.md b/demo-repository/exercises/demo-multi/demoM-prof/descr.md new file mode 100644 index 000000000..13c15704a --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-prof/descr.md @@ -0,0 +1,8 @@ +The following example link will open another tab/window: [OCaml](https://ocaml.org "External link") +This exercise is just another demo for the exercise environment. +Test + +
+ Hint + Use an indirection. +
diff --git a/demo-repository/exercises/demo-multi/demoM-prof/meta.json b/demo-repository/exercises/demo-multi/demoM-prof/meta.json new file mode 100644 index 000000000..6f1d64e8b --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-prof/meta.json @@ -0,0 +1,2 @@ +{"learnocaml_version":"1","kind":"exercise","stars":0, + "title":"Demo of the exercise environment (MD version)"} diff --git a/demo-repository/exercises/demo-multi/demoM-prof/prelude.ml b/demo-repository/exercises/demo-multi/demoM-prof/prelude.ml new file mode 100644 index 000000000..8436a905e --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-prof/prelude.ml @@ -0,0 +1,2 @@ +(* Some code is loaded in the toplevel before your code. *) +let greetings = "Hello world!" diff --git a/demo-repository/exercises/demo-multi/demoM-prof/prepare.ml b/demo-repository/exercises/demo-multi/demoM-prof/prepare.ml new file mode 100644 index 000000000..e69de29bb diff --git a/demo-repository/exercises/demo-multi/demoM-prof/solution.ml b/demo-repository/exercises/demo-multi/demoM-prof/solution.ml new file mode 100644 index 000000000..cb7e63583 --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-prof/solution.ml @@ -0,0 +1,4 @@ +let plus = (+) +let times = ( * ) +let minus = ( - ) +let divide = ( / ) diff --git a/demo-repository/exercises/demo-multi/demoM-prof/template.ml b/demo-repository/exercises/demo-multi/demoM-prof/template.ml new file mode 100644 index 000000000..8292e5d81 --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-prof/template.ml @@ -0,0 +1,6 @@ + +let plus x y = x + y ;; + +let minus x y = y - x ;; + +let times x y = x * diff --git a/demo-repository/exercises/demo-multi/demoM-prof/test.ml b/demo-repository/exercises/demo-multi/demoM-prof/test.ml new file mode 100644 index 000000000..91ca022bd --- /dev/null +++ b/demo-repository/exercises/demo-multi/demoM-prof/test.ml @@ -0,0 +1,26 @@ +open Test_lib +open Report + +let () = + set_result @@ + ast_sanity_check code_ast @@ fun () -> + [ Section + ([ Text "Function:" ; Code "plus" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "plus" + [ (1, 1) ; (2, 2) ; (10, -10) ]) ; + Section + ([ Text "Function:" ; Code "minus" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "minus" + [ (1, 1) ; (4, -2) ; (0, 10) ]) ; + Section + ([ Text "Function:" ; Code "times" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "times" + [ (1, 3) ; (2, 4) ; (3, 0) ]) ; + Section + ([ Text "Function:" ; Code "divide" ], + test_function_2_against_solution + [%ty : int -> int -> int ] "divide" + [ (12, 4) ; (12, 5) ; (3, 0) ]) ] diff --git a/demo-repository/exercises/demo-multi/subindex.json b/demo-repository/exercises/demo-multi/subindex.json new file mode 100644 index 000000000..2e8025dfe --- /dev/null +++ b/demo-repository/exercises/demo-multi/subindex.json @@ -0,0 +1,36 @@ +{ "learnocaml_version": "1", + "meta": { + "learnocaml_version" : "2", + "kind" : "problem", + "stars" : 2, + "title" : "Demo of a multi-part exercise", + "identifier" : "demo-multi", + "authors" : [["Someone", "someone@example.com"]], + "focus" : ["skill1", "skillN", "concept1", "conceptM"], + "requirements" : ["skill1", "skillN", "concept1", "conceptM"], + "forward_exercises" : [ "exercise1", "exercise2"], + "backward_exercises" : [ "exercise1", "exercise2"], + "max_score" : 100 + }, + "check_all_against": "demoM-prof", + "parts": [ + { "subtitle": "First test", + "subexercise": "demoM-exo1", + "student_hidden": false, + "student_weight": 1, + "teacher_weight": 0 + }, + { "subtitle": "Second test", + "subexercise": "demoM-exo2", + "student_hidden": false, + "student_weight": 1, + "teacher_weight": 0 + }, + { "subtitle": "Grading", + "subexercise": "demoM-prof", + "student_hidden": true, + "student_weight": 0, + "teacher_weight": 1 + } + ] +} diff --git a/demo-repository/exercises/index.json b/demo-repository/exercises/index.json index 35635a1fc..9cb5f5795 100644 --- a/demo-repository/exercises/index.json +++ b/demo-repository/exercises/index.json @@ -2,4 +2,4 @@ "groups": { "demo": { "title": "Demo exercise pack", - "exercises": [ "demo", "demo2" ] } } } + "exercises": [ "demo", "demo2", "demo-multi" ] } } } diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index a7ccd0eb5..18f86c32e 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -549,7 +549,8 @@ let stars_div stars = H.img ~alt ~src () ] -let exercise_text ex_meta exo = +let exercise_text ex_meta ex = + let mathjax_url = api_server ^ "/js/mathjax/MathJax.js?delayStartupUntil=configured" in @@ -575,10 +576,10 @@ let exercise_text ex_meta exo = let descr = let lang = "" in try - List.assoc lang (Learnocaml_exercise.(access File.descr exo)) + List.assoc lang (Learnocaml_exercise.(access false File.descr (ex))) with Not_found -> - try List.assoc "" (Learnocaml_exercise.(access File.descr exo)) + try List.assoc "" (Learnocaml_exercise.(access false File.descr (ex))) with Not_found -> [%i "No description available for this exercise." ] in Format.asprintf @@ -980,6 +981,9 @@ module Editor_button (E : Editor_info) = struct end +(*let update_template template (E : Editor_info) = Ace.set_contents E.ace template; + Lwt.return ()*) + let setup_editor id solution = let editor_pane = find_component "learnocaml-exo-editor-pane" in let editor = @@ -1032,7 +1036,7 @@ let setup_tab_text_prelude_pane prelude = let open Tyxml_js.Html5 in let state = ref (match arg "tab_text_prelude" with - | exception Not_found -> true + | exception Not_found -> false | "shown" -> true | "hidden" -> false | _ -> failwith "Bad format for argument prelude.") in @@ -1060,6 +1064,33 @@ let setup_tab_text_prelude_pane prelude = Manip.appendChildren prelude_pane [ prelude_title ; prelude_container ] + +let update_prelude prelude = + if prelude = "" then () else + let prelude_pane = find_component "learnocaml-exo-prelude" in + let open Tyxml_js.Html5 in + let state = + ref (match arg "prelude" with + | exception Not_found -> true + | "shown" -> true + | "hidden" -> false + | _ -> failwith "Bad format for argument prelude.") in + let prelude_container = + pre ~a: [ a_class [ "toplevel-code" ] ] + (Learnocaml_toplevel_output.format_ocaml_code prelude) in + let update () = + if !state then begin + Manip.SetCss.display prelude_container "" ; + end else begin + Manip.SetCss.display prelude_container "none" ; + end in + update () ; + Manip.appendChildren prelude_pane + [ prelude_container ] + + + + let setup_prelude_pane ace prelude = if prelude = "" then () else let editor_pane = find_component "learnocaml-exo-editor-pane" in @@ -1234,7 +1265,7 @@ module Display_exercise = else ignore (onclick cid); Manip.removeChildren exp; - Manip.appendChild exp (txt (if !displayed then "[-]" else "[+]")); + Manip.appendChild exp (txt (if !displayed then "[+]" else "[-]")); displayed := not !displayed; true in diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index 90d917aaa..732a6f1f3 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -230,6 +230,8 @@ val set_nickname_div : unit -> unit val setup_tab_text_prelude_pane : string -> unit +val update_prelude : string -> unit + val setup_prelude_pane : 'a Ace.editor -> string -> unit val get_token : ?has_server:bool -> unit -> Learnocaml_data.student Learnocaml_data.token option Lwt.t diff --git a/src/app/learnocaml_description_main.ml b/src/app/learnocaml_description_main.ml index 6484d9f2a..4bde1a46e 100644 --- a/src/app/learnocaml_description_main.ml +++ b/src/app/learnocaml_description_main.ml @@ -54,7 +54,48 @@ module Exercise_link = module Display = Display_exercise(Exercise_link) open Display +exception Multipart_missing_exercise +exception Multipart_student_hidden +exception Multipart_state_outofbounds +exception Multipart_state_invalid +exception Multipart_forbidden_navigation + +type state_multipart = + Monopart +| Multipart of int * int (* numero du sous-exo, valeur max *) + +let state_multipart = ref Monopart + +let init_state_multipart exo = + let inival = + match exo, !state_multipart with + | Learnocaml_exercise.Exercise(_ex), _state -> Monopart + | Learnocaml_exercise.Subexercise(l), Monopart -> + let size = List.length l in + if size < 1 then raise Multipart_missing_exercise + else Multipart(1, size) + | Learnocaml_exercise.Subexercise(l), Multipart(num_prec, _) -> + let size = List.length l in + if size < 1 then raise Multipart_missing_exercise + else Multipart(min num_prec size, size) + in state_multipart := inival + +let get_current_part exo = + match exo, !state_multipart with + | Learnocaml_exercise.Exercise ex, Monopart -> ex + | Learnocaml_exercise.Subexercise l, Multipart (n, _nmax) -> + (match List.nth_opt l (n - 1) with + | Some(ex, subex) -> + if subex.Learnocaml_exercise.student_hidden + then raise Multipart_student_hidden + else ex + | None -> raise Multipart_state_outofbounds + ) + | _ -> raise Multipart_state_invalid + + let () = + print_string ("Test Show exo desc : 0 \n"); run_async_with_log @@ fun () -> let id = match Url.Current.path with | "" :: "description" :: p | "description" :: p -> @@ -69,20 +110,38 @@ let () = retrieve (Learnocaml_api.Exercise (Some token, id)) in init_tabs (); - exercise_fetch >>= fun (ex_meta, exo, _deadline) -> + exercise_fetch >>= fun (ex_meta, ex, _deadline) -> + init_state_multipart ex ; + let exo = get_current_part ex in + (* + let exo = match ex with + | Learnocaml_exercise.Subexercise ([]) -> raise Not_found + | Learnocaml_exercise.Subexercise ((exo, subex) :: _ ) -> + if subex.Learnocaml_exercise.student_hidden = false then exo + else raise Not_found + | Learnocaml_exercise.Exercise exo -> exo + in*) + let sub_id = "TODO" + in (* display exercise questions and prelude *) - setup_tab_text_prelude_pane Learnocaml_exercise.(decipher File.prelude exo); + setup_tab_text_prelude_pane Learnocaml_exercise.(decipher ~subid:sub_id false File.prelude (Learnocaml_exercise.Exercise exo)); + let prelude_container = find_component "learnocaml-exo-tab-text-prelude" in + let iframe_container = find_component "learnocaml-exo-tab-text-iframe" in let text_iframe = Dom_html.createIframe Dom_html.document in Manip.replaceChildren title_container Tyxml_js.Html5.[ h1 [ txt ex_meta.title] ]; + Manip.replaceChildren iframe_container + [Tyxml_js.Of_dom.of_iFrame text_iframe]; Manip.replaceChildren text_container - [ Tyxml_js.Of_dom.of_iFrame text_iframe ]; + [title_container; + prelude_container; + iframe_container ]; Js.Opt.case (text_iframe##.contentDocument) (fun () -> failwith "cannot edit iframe document") (fun d -> d##open_; - d##write (Js.string (exercise_text ex_meta exo)); + d##write (Js.string (exercise_text ex_meta (Learnocaml_exercise.Exercise exo))); d##close) ; (* display meta *) display_meta (Some token) ex_meta id >>= fun () -> diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index bea8bde16..dfe92e3f3 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -49,7 +49,7 @@ let display_report exo report = Manip.removeClass report_button "failure" ; Manip.removeClass report_button "partial" ; let grade = - let max = Learnocaml_exercise.(access File.max_score exo) in + let max = Learnocaml_exercise.(access false File.max_score exo) in if max = 0 then 999 else score * 100 / max in if grade >= 100 then begin @@ -87,6 +87,69 @@ open Display let is_readonly = ref false +type state_multipart = + Monopart +| Multipart of int * int (* numero du sous-exo, valeur max *) + +let state_multipart = ref Monopart + +exception Multipart_missing_exercise +exception Multipart_student_hidden +exception Multipart_state_outofbounds +exception Multipart_state_invalid +exception Multipart_forbidden_navigation + +(* XXX cette fonction est exécutée à chaque fois qu'un exercice + (monopart ou multi-part) est récupéré du serveur, pour initialiser + l'état stockant le numéro du sous-exercice. + Si l'état actuel spécifie un numéro déjà valide (1 <= _ <= new_max) + alors celui-ci est préservé, + Sinon on prend (min num_prec new_max), + ou alors 0 si le num_prec n'existe pas. + Mais dans tous les cas, on ne lève pas d'erreur si possible. *) +let init_state_multipart exo = + let inival = + match exo, !state_multipart with + | Learnocaml_exercise.Exercise(_ex), _state -> Monopart + | Learnocaml_exercise.Subexercise(l), Monopart -> + let size = List.length l in + if size < 1 then raise Multipart_missing_exercise + else Multipart(1, size) + | Learnocaml_exercise.Subexercise(l), Multipart(num_prec, _) -> + let size = List.length l in + if size < 1 then raise Multipart_missing_exercise + else Multipart(min num_prec size, size) + in state_multipart := inival + +let get_current_part exo = + match exo, !state_multipart with + | Learnocaml_exercise.Exercise ex, Monopart -> ex + | Learnocaml_exercise.Subexercise l, Multipart (n, _nmax) -> + (match List.nth_opt l (n - 1) with + | Some(ex, subex) -> + if subex.Learnocaml_exercise.student_hidden + then raise Multipart_student_hidden + else ex + | None -> raise Multipart_state_outofbounds + ) + | _ -> raise Multipart_state_invalid + +let next () = print_endline("Btn_next"); + let newval = match !state_multipart with + | Monopart -> raise Multipart_forbidden_navigation + | Multipart (n, nmax) -> + if n < nmax then Multipart(n + 1, nmax) + else raise Multipart_forbidden_navigation + in state_multipart := newval + +let prev () = print_endline("Btn_prev"); + let newval = match !state_multipart with + | Monopart -> raise Multipart_forbidden_navigation + | Multipart (n, nmax) -> + if n > 1 then Multipart(n - 1, nmax) + else raise Multipart_forbidden_navigation + in state_multipart := newval + let make_readonly () = is_readonly := true; alert ~title:[%i"TIME'S UP"] @@ -94,6 +157,7 @@ let make_readonly () = from now on will remain local only."] let () = + print_string ("Test Show exo find : 0 \n"); run_async_with_log @@ fun () -> set_string_translations_exercises (); Learnocaml_local_storage.init (); @@ -123,15 +187,17 @@ let () = in let after_init top = exercise_fetch >>= fun (_meta, exo, _deadline) -> - begin match Learnocaml_exercise.(decipher File.prelude exo) with + init_state_multipart exo ; + let ex = get_current_part exo in + begin match Learnocaml_exercise.(decipher false File.prelude (Learnocaml_exercise.Exercise ex)) with | "" -> Lwt.return true - | prelude -> + | prelude -> print_endline("prelude:"^prelude); Learnocaml_toplevel.load ~print_outcome:true top ~message: [%i"loading the prelude..."] prelude end >>= fun r1 -> Learnocaml_toplevel.load ~print_outcome:false top - (Learnocaml_exercise.(decipher File.prepare exo)) >>= fun r2 -> + (Learnocaml_exercise.(decipher false File.prepare (Learnocaml_exercise.Exercise ex))) >>= fun r2 -> if not r1 || not r2 then failwith [%i"error in prelude"] ; Learnocaml_toplevel.set_checking_environment top >>= fun () -> Lwt.return () in @@ -144,6 +210,8 @@ let () = set_nickname_div (); toplevel_launch >>= fun top -> exercise_fetch >>= fun (ex_meta, exo, deadline) -> + init_state_multipart exo; + let ex = get_current_part exo in (match deadline with | None -> () | Some 0. -> make_readonly () @@ -158,7 +226,8 @@ let () = solution | { Answer.report = None ; solution ; _ } -> solution - | exception Not_found -> Learnocaml_exercise.(access File.template exo) in + | exception Not_found -> print_endline("template:"); + Learnocaml_exercise.(access false File.template (Learnocaml_exercise.Exercise ex)) in (* ---- details pane -------------------------------------------------- *) let load_meta () = Lwt.async (fun () -> @@ -182,20 +251,94 @@ let () = let editor, ace = setup_editor id solution in is_synchronized_with_server_callback := (fun () -> Ace.is_synchronized ace); let module EB = Editor_button (struct let ace = ace let buttons_container = editor_toolbar end) in - EB.cleanup (Learnocaml_exercise.(access File.template exo)); + EB.cleanup (Learnocaml_exercise.(access false File.template (Learnocaml_exercise.Exercise ex))); EB.sync token id (fun () -> Ace.focus ace; Ace.set_synchronized ace) ; EB.download id; EB.eval top select_tab; let typecheck = typecheck top ace editor in (*------------- prelude -----------------*) - setup_prelude_pane ace Learnocaml_exercise.(decipher File.prelude exo); + setup_prelude_pane ace Learnocaml_exercise.(decipher false File.prelude (Learnocaml_exercise.Exercise ex)); Js.Opt.case (text_iframe##.contentDocument) (fun () -> failwith "cannot edit iframe document") (fun d -> d##open_; - d##write (Js.string (exercise_text ex_meta exo)); + d##write (Js.string (exercise_text ex_meta (Learnocaml_exercise.Exercise ex))); d##close) ; + (* ------------------- Subexercise navigation -------- *) + + let nav_available = match exo with + | Learnocaml_exercise.Exercise _ -> false + | Learnocaml_exercise.Subexercise _ -> true + in + (* Traitement du "sous-index" pour savoir si on peut naviguer *) + init_state_multipart exo ; + + let navigation_toolbar = find_component "learnocaml-exo-tab-navigation" in + (*let navigation_toolbar = + Tyxml_js.Html5.(div ~a: [ a_class [ "learnocaml-exo-tab-navigation" ] ] []) in*) + let subtitle_field = Tyxml_js.Html5.(h4 ~a: [a_class ["learnocaml-exo-subtitle"]] + [txt id]) in + let prev_button_state = button_state () in + let next_button_state = button_state () in + + let actualise_state_btn () = print_endline("_state"); + begin match !state_multipart with + | Monopart | Multipart(1, 1) -> + disable_button prev_button_state ; + disable_button next_button_state + | Multipart(1, nmax) when nmax > 1 -> + disable_button prev_button_state ; + enable_button next_button_state + | Multipart(n, nmax) when n = nmax && n > 1 -> + enable_button prev_button_state ; + disable_button next_button_state + | Multipart(n, nmax) when 1 < n && n < nmax -> + enable_button prev_button_state ; + enable_button next_button_state + | _ -> + raise Multipart_state_invalid + end in + let get_content_subex () = let ex = get_current_part exo in + + (*let template = Learnocaml_exercise.(access false File.template (Learnocaml_exercise.Exercise ex)) in update_template template (struct let ace = ace let buttons_container = editor_toolbar end); common l984*) + + let prelude = Learnocaml_exercise.(decipher false File.prelude (Learnocaml_exercise.Exercise ex)) in update_prelude prelude ; + + Js.Opt.case + (text_iframe##.contentDocument) + (fun () -> failwith "cannot edit iframe document") + (fun d -> + d##open_; + d##write (Js.string (exercise_text ex_meta (Learnocaml_exercise.Exercise ex))); + d##close) ; + + Lwt.return () + in + if nav_available then + ( + actualise_state_btn () ; + begin button + ~state: prev_button_state ~container: navigation_toolbar + ~theme: "black" ~icon: "left" [%i"Prev"] @@ fun () -> + prev () ; + actualise_state_btn () ; + get_content_subex () + end ; + Manip.appendChild navigation_toolbar subtitle_field ; + begin button + ~state: next_button_state ~container: navigation_toolbar + ~theme: "black" ~icon: "right" [%i"Next"] @@ fun () -> + next () ; + actualise_state_btn () ; + get_content_subex () + end ; + ) + else + (Manip.appendChild navigation_toolbar subtitle_field ; + Manip.SetCss.width subtitle_field "100%"; + ); + (* ---- main toolbar -------------------------------------------------- *) let exo_toolbar = find_component "learnocaml-exo-toolbar" in let toolbar_button = button ~container: exo_toolbar ~theme: "light" in @@ -288,6 +431,11 @@ let () = Ace.focus ace ; typecheck true end ; + if nav_available then + begin toolbar_button + ~icon: "reload" [%i"Grade everything!"] @@ fun () -> + typecheck true + end; (* Small but cross-compatible hack (tested with Firefox-ESR, Chromium, Safari) * that reuses part of this commit: * https://github.com/pfitaxel/learn-ocaml/commit/15780b5b7c91689a26cfeaf33f3ed2cdb3a5e801 diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 1019e8bf1..302140f0d 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -80,64 +80,122 @@ let exercises_tab token _ _ () = match contents with | Exercise.Index.Exercises exercises -> List.fold_left - (fun acc (exercise_id, meta_opt) -> - match meta_opt with None -> acc | Some meta -> - let {Exercise.Meta.kind; title; short_description; stars; _ } = - meta - in - let pct_init = - match SMap.find exercise_id all_exercise_states with - | exception Not_found -> None - | { Answer.grade ; _ } -> grade in - let pct_signal, pct_signal_set = React.S.create pct_init in - Learnocaml_local_storage.(listener (exercise_state exercise_id)) := - Some (function - | Some { Answer.grade ; _ } -> pct_signal_set grade - | None -> pct_signal_set None) ; - let pct_text_signal = - React.S.map - (function - | None -> "--" - | Some 0 -> "0%" - | Some pct -> string_of_int pct ^ "%") - pct_signal in - let time_left = match List.assoc_opt exercise_id deadlines with - | None -> "" - | Some 0. -> [%i"Exercise closed"] - | Some f -> Printf.sprintf [%if"Time left: %s"] - (string_of_seconds (int_of_float f)) - in - let status_classes_signal = - React.S.map - (function - | None -> [ "stats" ] - | Some 0 -> [ "stats" ; "failure" ] - | Some pct when pct >= 100 -> [ "stats" ; "success" ] - | Some _ -> [ "stats" ; "partial" ]) - pct_signal in - a ~a:[ a_href (get_url token "/exercises/" "exercise.html#id=" exercise_id) ; - a_class [ "exercise" ] ] [ - div ~a:[ a_class [ "descr" ] ] ( - h1 [ txt title ] :: - begin match short_description with - | None -> [] - | Some text -> [ txt text ] - end - ); - div ~a:[ a_class [ "time-left" ] ] [H.txt time_left]; - div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [ - stars_div stars; - div ~a:[ a_class [ "length" ] ] [ - match kind with - | Exercise.Meta.Project -> txt [%i"project"] - | Exercise.Meta.Problem -> txt [%i"problem"] - | Exercise.Meta.Exercise -> txt [%i"exercise"] ] ; - div ~a:[ a_class [ "score" ] ] [ - Tyxml_js.R.Html5.txt pct_text_signal - ] - ] ] :: - acc) - acc exercises + (fun acc (exercise_id, meta_opt, subindex_opt) -> + match meta_opt,subindex_opt with + | None, None -> acc + | Some meta, _ -> + let {Exercise.Meta.kind; title; short_description; stars; _ } = + meta + in + let pct_init = + match SMap.find exercise_id all_exercise_states with + | exception Not_found -> None + | { Answer.grade ; _ } -> grade in + let pct_signal, pct_signal_set = React.S.create pct_init in + Learnocaml_local_storage.(listener (exercise_state exercise_id)) := + Some (function + | Some { Answer.grade ; _ } -> pct_signal_set grade + | None -> pct_signal_set None) ; + let pct_text_signal = + React.S.map + (function + | None -> "--" + | Some 0 -> "0%" + | Some pct -> string_of_int pct ^ "%") + pct_signal in + let time_left = match List.assoc_opt exercise_id deadlines with + | None -> "" + | Some 0. -> [%i"Exercise closed"] + | Some f -> Printf.sprintf [%if"Time left: %s"] + (string_of_seconds (int_of_float f)) + in + let status_classes_signal = + React.S.map + (function + | None -> [ "stats" ] + | Some 0 -> [ "stats" ; "failure" ] + | Some pct when pct >= 100 -> [ "stats" ; "success" ] + | Some _ -> [ "stats" ; "partial" ]) + pct_signal in + a ~a:[ a_href (get_url token "/exercises/" "exercise.html#id=" exercise_id) ; + a_class [ "exercise" ] ] [ + div ~a:[ a_class [ "descr" ] ] ( + h1 [ txt title ] :: + begin match short_description with + | None -> [] + | Some text -> [ txt text ] + end + ); + div ~a:[ a_class [ "time-left" ] ] [H.txt time_left]; + div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [ + stars_div stars; + div ~a:[ a_class [ "length" ] ] [ + match kind with + | Exercise.Meta.Project -> txt [%i"project"] + | Exercise.Meta.Problem -> txt [%i"problem"] + | Exercise.Meta.Exercise -> txt [%i"exercise"] ] ; + div ~a:[ a_class [ "score" ] ] [ + Tyxml_js.R.Html5.txt pct_text_signal + ] + ] ] :: + acc + | None, Some subindex -> + let {Exercise.Meta.kind; title; short_description; stars; _ } = + Learnocaml_data.Exercise.Subindex.to_meta subindex + in + let pct_init = + match SMap.find exercise_id all_exercise_states with + | exception Not_found -> None + | { Answer.grade ; _ } -> grade in + let pct_signal, pct_signal_set = React.S.create pct_init in + Learnocaml_local_storage.(listener (exercise_state exercise_id)) := + Some (function + | Some { Answer.grade ; _ } -> pct_signal_set grade + | None -> pct_signal_set None) ; + let pct_text_signal = + React.S.map + (function + | None -> "--" + | Some 0 -> "0%" + | Some pct -> string_of_int pct ^ "%") + pct_signal in + let time_left = match List.assoc_opt exercise_id deadlines with + | None -> "" + | Some 0. -> [%i"Exercise closed"] + | Some f -> Printf.sprintf [%if"Time left: %s"] + (string_of_seconds (int_of_float f)) + in + let status_classes_signal = + React.S.map + (function + | None -> [ "stats" ] + | Some 0 -> [ "stats" ; "failure" ] + | Some pct when pct >= 100 -> [ "stats" ; "success" ] + | Some _ -> [ "stats" ; "partial" ]) + pct_signal in + a ~a:[ a_href (get_url token "/exercises/" "exercise.html#id=" exercise_id) ; + a_class [ "exercise" ] ] [ + div ~a:[ a_class [ "descr" ] ] ( + h1 [ txt title ] :: + begin match short_description with + | None -> [] + | Some text -> [ txt text ] + end + ); + div ~a:[ a_class [ "time-left" ] ] [H.txt time_left]; + div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [ + stars_div stars; + div ~a:[ a_class [ "length" ] ] [ + match kind with + | Exercise.Meta.Project -> txt [%i"project"] + | Exercise.Meta.Problem -> txt [%i"problem"] + | Exercise.Meta.Exercise -> txt [%i"exercise"] ] ; + div ~a:[ a_class [ "score" ] ] [ + Tyxml_js.R.Html5.txt pct_text_signal + ] + ] ] :: + acc) + acc exercises | Exercise.Index.Groups groups -> let h = match lvl with 1 -> h1 | 2 -> h2 | _ -> h3 in List.fold_left diff --git a/src/app/learnocaml_student_view.ml b/src/app/learnocaml_student_view.ml index c7b3d1303..5bf0f88d8 100644 --- a/src/app/learnocaml_student_view.ml +++ b/src/app/learnocaml_student_view.ml @@ -387,7 +387,7 @@ let display_report exo report = let report_button = El.Tabs.(report.btn) in restore_report_button (); let grade = - let max = Learnocaml_exercise.(access File.max_score exo) in + let max = Learnocaml_exercise.(access true File.max_score exo) in if max = 0 then 999 else score * 100 / max in if grade >= 100 then begin @@ -455,6 +455,7 @@ let update_tabs meta exo ans = update_answer_tab ans.Answer.solution let () = + print_string ("Test Show exo stV : \n"); run_async_with_log @@ fun () -> (* set_string_translations (); *) (* Manip.setInnerText El.version ("v."^Learnocaml_api.version); *) diff --git a/src/app/learnocaml_teacher_tab.ml b/src/app/learnocaml_teacher_tab.ml index 28a7e9ab1..7f985612d 100644 --- a/src/app/learnocaml_teacher_tab.ml +++ b/src/app/learnocaml_teacher_tab.ml @@ -204,7 +204,7 @@ let rec teacher_tab token _select _params () = mk_table (group_level + 1) acc status g.Exercise.Index.contents) acc groups_list | Exercise.Index.Exercises exlist -> - List.fold_left (fun acc (id, meta) -> + List.fold_left (fun acc (id, meta, _subindex) -> let open_exercise_ () = let _win = window_open ("/exercises/"^id^"/") "_blank" in false @@ -301,7 +301,7 @@ let rec teacher_tab token _select _params () = empty && empty0, List.rev_append hidden hidden0) (true, []) groups_list | Exercise.Index.Exercises l -> - List.fold_left (fun (empty, hidden) (id, ex) -> + List.fold_left (fun (empty, hidden) (id, ex, _subindex) -> let elt = find_component (exercise_line_id id) in match ex with | Some ex when matches id ex -> diff --git a/src/app/server_caller.ml b/src/app/server_caller.ml index 3631e90df..a9382d1e2 100644 --- a/src/app/server_caller.ml +++ b/src/app/server_caller.ml @@ -86,7 +86,9 @@ let request req = in Lwt.catch (fun () -> Api_client.make_request (fun http_request -> - Lwt.catch (fun () -> do_req http_request >|= fun body -> Ok (body)) + Lwt.catch (fun () -> + do_req http_request >|= fun body -> + Ok (body)) @@ function | Lwt_request.Request_failed (0, s) -> Lwt.return (Error (`Unreachable s)) diff --git a/src/grader/grader_cli.ml b/src/grader/grader_cli.ml index 709f1a641..aeed67f7c 100644 --- a/src/grader/grader_cli.ml +++ b/src/grader/grader_cli.ml @@ -47,13 +47,16 @@ let read_student_file exercise_dir path = else Lwt_io.with_file ~mode:Lwt_io.Input fn Lwt_io.read -let grade ?(print_result=false) ?dirname meta exercise output_json = +let grade ?(check=None) ?(print_result=false) ?dirname meta exercise output_json = Lwt.catch (fun () -> - let code_to_grade = match !grade_student with + let code_to_grade = match check with + | Some path -> read_student_file (Sys.getcwd ()) ( path ^ "/solution.ml") + | None -> + match !grade_student with | Some path -> read_student_file (Sys.getcwd ()) path | None -> - Lwt.return (Learnocaml_exercise.(decipher File.solution exercise)) in + Lwt.return (Learnocaml_exercise.(decipher true File.solution exercise)) in let callback = if !display_callback then Some (Printf.eprintf "[ %s ]%!\r\027[K") else None in let timeout = !individual_timeout in @@ -138,20 +141,20 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = if failure then begin if print_result then Printf.eprintf "%-30s - Failure - %d points\n%!" - Learnocaml_exercise.(access File.id exercise) max; + Learnocaml_exercise.(access true File.id exercise) max; Lwt.return (Error max) end else begin if print_result then Printf.eprintf "%-30s - Success - %d points\n%!" - Learnocaml_exercise.(access File.id exercise) max; + Learnocaml_exercise.(access true File.id exercise) max; match output_json with | None -> Lwt.return (Ok ()) | Some json_file -> let json = Json_encoding.(construct (tup3 Learnocaml_data.Exercise.Meta.enc Learnocaml_exercise.encoding (option float))) - (meta, Learnocaml_exercise.(update File.max_score max exercise), None) + (meta, Learnocaml_exercise.Exercise (Learnocaml_exercise.(update File.max_score max exercise)), None) in let json = match json with | `A _ | `O _ as d -> d @@ -183,4 +186,4 @@ let grade_from_dir ?(print_result=false) exercise_dir output_json = | "" -> `O [] | s -> Ezjsonm.from_string s) |> Json_encoding.destruct Learnocaml_data.Exercise.Meta.enc in - grade ~print_result ~dirname:exercise_dir meta exo output_json + grade ~print_result ~dirname:exercise_dir meta (Learnocaml_exercise.Exercise exo) output_json diff --git a/src/grader/grader_cli.mli b/src/grader/grader_cli.mli index e66095ef7..5073b375b 100644 --- a/src/grader/grader_cli.mli +++ b/src/grader/grader_cli.mli @@ -39,7 +39,7 @@ val dump_dot: string option ref (** Runs the grading process *) val grade: - ?print_result:bool -> ?dirname:string -> Learnocaml_data.Exercise.Meta.t -> Learnocaml_exercise.t -> string option -> + ?check: string option -> ?print_result:bool -> ?dirname:string -> Learnocaml_data.Exercise.Meta.t -> Learnocaml_exercise.t -> string option -> (unit, int) result Lwt.t val grade_from_dir: diff --git a/src/grader/grading.ml b/src/grader/grading.ml index 83b6a1283..d30f7555f 100644 --- a/src/grader/grading.ml +++ b/src/grader/grading.ml @@ -100,12 +100,12 @@ let get_grade set_progress [%i"Loading the prelude."] ; handle_error (internal_error [%i"while loading the prelude"]) @@ Toploop_ext.use_string ~print_outcome ~ppf_answer ~filename:(file "prelude.ml") - (Learnocaml_exercise.(decipher File.prelude exo)) ; + (Learnocaml_exercise.(decipher false File.prelude exo)) ; set_progress [%i"Preparing the test environment."] ; handle_error (internal_error [%i"while preparing the tests"]) @@ Toploop_ext.use_string ~print_outcome ~ppf_answer ~filename:(file "prepare.ml") - (Learnocaml_exercise.(decipher File.prepare exo)) ; + (Learnocaml_exercise.(decipher false File.prepare exo)) ; set_progress [%i"Loading your code."] ; handle_error user_code_error @@ @@ -115,7 +115,7 @@ let get_grade set_progress [%i"Loading the solution."] ; handle_error (internal_error [%i"while loading the solution"]) @@ Toploop_ext.use_mod_string ~print_outcome ~ppf_answer ~modname:"Solution" - (Learnocaml_exercise.(decipher File.solution exo)) ; + (Learnocaml_exercise.(decipher false File.solution exo)) ; set_progress [%i"Preparing to launch the tests."] ; Introspection.allow_introspection ~divert ; @@ -147,12 +147,12 @@ let get_grade let () = let open Learnocaml_exercise in - let files = File.dependencies (access File.depend exo) in + let files = File.dependencies (access false File.depend exo) in let rec load_dependencies signatures = function | [] -> () (* signatures without implementation are ignored *) | file::fs -> let path = File.key file - and content = decipher file exo in + and content = decipher false file exo in let modname = String.capitalize_ascii @@ Filename.remove_extension @@ Filename.basename path in match Filename.extension path with @@ -190,7 +190,7 @@ let get_grade handle_error (internal_error [%i"while testing your solution"]) @@ Toploop_ext.use_string ~print_outcome ~ppf_answer ~filename:(file "test.ml") - (Learnocaml_exercise.(decipher File.test exo)) ; + (Learnocaml_exercise.(decipher false File.test exo)) ; (* Memory cleanup... *) Toploop.initialize_toplevel_env () ; diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index 1b3496bf8..a29f7621e 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -376,7 +376,7 @@ let get_score = in get_score 0 -let max_score exo = Learnocaml_exercise.(access File.max_score exo) +let max_score exo = Learnocaml_exercise.(access false File.max_score exo) let print_score ?(max=1) ?color i = let color = match color with @@ -503,7 +503,7 @@ let upload_save server_url token save = let upload_report server token ex solution report = let score = get_score report in let max_score = max_score ex in - let id = Learnocaml_exercise.(access File.id ex) in + let id = Learnocaml_exercise.(access (Learnocaml_data.Token.is_student token) File.id ex) in let mtime = Unix.gettimeofday () in let exercise_state = { Answer. @@ -1169,7 +1169,7 @@ module Template = struct >>= fun (_meta, exercise, _deadline) -> write_exercise_file exercise_id - Learnocaml_exercise.(access File.template exercise) + Learnocaml_exercise.(access false File.template exercise) >|= function | true -> 0 | false -> 3 diff --git a/src/repo/learnocaml_exercise.ml b/src/repo/learnocaml_exercise.ml index 7a476fb7b..4323c5823 100644 --- a/src/repo/learnocaml_exercise.ml +++ b/src/repo/learnocaml_exercise.ml @@ -8,7 +8,19 @@ type id = string -type t = +type check_all_against = string option + +type subexercise = + { sub_id : id; + student_hidden : bool; + student_weight : int; + teacher_weight : int; + } + +let construct_subexercise sub_id student_hidden student_weight teacher_weight = + {sub_id; student_hidden; student_weight; teacher_weight} + +type exercise = { id : id ; prelude : string ; template : string ; @@ -21,24 +33,75 @@ type t = dependencies : string list; } +type t = + | Exercise of exercise + | Subexercise of (exercise * subexercise) list + let encoding = let open Json_encoding in - conv - (fun { id ; prelude ; template ; descr ; prepare ; test ; solution ; max_score ; depend ; dependencies} -> - id, prelude, template, descr, prepare, test, solution, max_score,depend, dependencies) - (fun (id, prelude, template, descr, prepare, test, solution, max_score,depend, dependencies) -> - { id ; prelude ; template ; descr ; prepare ; test ; solution ; max_score ; depend ; dependencies}) - (obj10 - (req "id" string) - (req "prelude" string) - (req "template" string) - (req "descr" (list (tup2 string string))) - (req "prepare" string) - (req "test" string) - (req "solution" string) - (req "max-score" int) - (opt "depend" (string)) - (dft "dependencies" (list string) [])) + let exercise_enc = + conv + (fun { id ; prelude ; template ; descr ; prepare ; test ; solution ; max_score ; depend ; dependencies} -> + id, prelude, template, descr, prepare, test, solution, max_score,depend, dependencies) + (fun (id, prelude, template, descr, prepare, test, solution, max_score,depend, dependencies) -> + { id ; prelude ; template ; descr ; prepare ; test ; solution ; max_score ; depend ; dependencies}) + (obj10 + (req "id" string) + (req "prelude" string) + (req "template" string) + (req "descr" (list (tup2 string string))) + (req "prepare" string) + (req "test" string) + (req "solution" string) + (req "max-score" int) + (req "depend" (option string)) + (req "dependencies" (list string))) + in + let sub_enc = + conv + (fun { sub_id ; student_hidden ; student_weight ; teacher_weight } -> + sub_id, student_hidden, student_weight, teacher_weight) + (fun (sub_id, student_hidden, student_weight, teacher_weight) -> + { sub_id ; student_hidden ; student_weight ; teacher_weight }) + (obj4 + (req "sub_id" string) + (dft "student_hidden" bool false) + (req "student_weight" int) + (req "teacher_weight" int)) + in + let subexercise_enc = + (* + (* pas mal *) + obj1 + (req "parts" (list (tup2 exercise_enc sub_enc))) + *) + + (* mieux ? *) + (list (tup2 exercise_enc sub_enc)) + + (* + (* actuellement *) + obj1 + (req "parts" + (list (obj2 + (req "exercise" exercise_enc) + (req "subexercise" sub_enc)))) + *) + in + union + [case + exercise_enc + (function + | Exercise ex -> Some ex + |_ -> None) + (fun ex -> Exercise ex); + case + subexercise_enc + (function + | Subexercise subex -> Some subex + | _ -> None) + (fun subex -> Subexercise subex) + ] (* let meta_from_string m = * Ezjsonm.from_string m @@ -88,8 +151,8 @@ module File = struct ciphered : bool ; decode : string -> 'a ; encode : 'a -> string ; - field : t -> 'a ; - update : 'a -> t -> t ; + field : exercise -> 'a ; + update : 'a -> exercise -> exercise ; } exception Missing_file of string @@ -367,30 +430,55 @@ module File = struct include MakeReader (Seq) end -let access f ex = - f.File.field ex - -let decipher f ex = +let access ?(subid="") _is_Student f ex = + match ex with + | Exercise exo -> f.File.field exo + | Subexercise (subexos) -> + f.File.field @@ + (fun (ex,_) -> ex) @@ + List.find + (fun (ex,_subex) -> ex.id = subid) + subexos + +let decipher ?(subid="") _is_Student f ex = + let exo = match ex with + | Exercise exo -> exo + | Subexercise (subexos) -> + (fun (ex,_) -> ex) @@ + List.find + (fun (ex,_subex) -> ex.id = subid) + subexos + in let open File in - let raw = f.field ex in + let raw = f.field exo in if f.ciphered then let prefix = - Digest.string (ex.id ^ "_" ^ f.key) in + Digest.string (exo.id ^ "_" ^ f.key) in f.decode (Learnocaml_xor.decode ~prefix raw) else f.decode raw -let update f v ex = - f.File.update v ex - -let cipher f v ex = +let update ?(subid="") f v ex = + let exo = match ex with + | Exercise exo -> exo + | Subexercise (subexos) -> (fun (ex,_) -> ex) @@ + List.find (fun (ex,_) -> ex.id = subid) subexos + in + f.File.update v exo + +let cipher ?(subid="") f v ex = + let exo = match ex with + | Exercise exo -> exo + | Subexercise (subexos) -> (fun (ex,_) -> ex) @@ + List.find (fun (ex, _) -> ex.id = subid) subexos + in let open File in if f.ciphered then let prefix = - Digest.string (ex.id ^ "_" ^ f.key) in - f.update (Learnocaml_xor.encode ~prefix (f.encode v)) ex + Digest.string (exo.id ^ "_" ^ f.key) in + f.update (Learnocaml_xor.encode ~prefix (f.encode v)) exo else - f.update (f.encode v) ex + f.update (f.encode v) exo let field_from_file file files = try File.(StringMap.find file.key files |> file.decode) @@ -428,7 +516,7 @@ module MakeReaderAnddWriter (Concur : Concur) = struct } with File.Missing_file _ as e -> fail e - let write ~write_field ex ?(cipher = true) acc = + let write ~write_field ex ?(cipher = true) is_Student acc = let open Concur in let open File in let acc = ref acc in @@ -458,7 +546,7 @@ module MakeReaderAnddWriter (Concur : Concur) = struct write_field test ; write_field depend ; (* write_field max_score *) ] - @ (List.map write_field (dependencies (access depend ex))) ) + @ (List.map write_field (dependencies (access is_Student depend (Exercise ex)))) ) >>= fun () -> return !acc end diff --git a/src/repo/learnocaml_exercise.mli b/src/repo/learnocaml_exercise.mli index 1bb8809a7..fa0186fa2 100644 --- a/src/repo/learnocaml_exercise.mli +++ b/src/repo/learnocaml_exercise.mli @@ -9,10 +9,36 @@ (** Internal representation of the exercises files, including the metadata from the repository. *) -type t - type id = string +type check_all_against = string option + +type subexercise = + { sub_id : id; + student_hidden : bool; + student_weight : int; + teacher_weight : int; + } + +val construct_subexercise : id -> bool -> int -> int -> subexercise + +type exercise = { + id : id; + prelude : string; + template : string; + descr : (string * string) list; + prepare : string; + test : string; + solution : string; + max_score : int; + depend : string option; + dependencies : string list; + } + +type t = + | Exercise of exercise + | Subexercise of (exercise * subexercise) list + (* JSON encoding of the exercise representation. Includes cipher and decipher at at encoding and decoding. *) val encoding: t Json_encoding.encoding @@ -82,43 +108,47 @@ end (** Access a field from the exercise, using the [t] representation, without ** deciphering it. May raise [Missing_file] if the field is optional and set to - [None]. *) -val access: 'a File.file -> t -> 'a + [None]. + For subexercises, cannot access if the users is a student and the subexercise + is student_hidden. It will raise a Not_found exeption *) +val access: ?subid:id -> bool -> 'a File.file -> t -> 'a (** Access a string field from the exercise, using the [t] representation, and deciphers if necessary. May raise [Missing_file] if the field is optional and - set to [None]. *) -val decipher: string File.file -> t -> string + set to [None]. + For subexercises, cannot access and decipher if the users is a student and the subexercise + is student_hidden. It will raise a Not_found exeption *) +val decipher: ?subid:id -> bool -> string File.file -> t -> string (** Updates the value of a field of the exercise in its [t] representation. *) -val update: 'a File.file -> 'a -> t -> t +val update: ?subid:id -> 'a File.file -> 'a -> t -> exercise (** Updates the value of a field of the exercise in its [t] representation, and ciphers it. *) -val cipher: string File.file -> string -> t -> t +val cipher: ?subid:id -> string File.file -> string -> t -> exercise (** Reader and decipherer *) val read: read_field:(string -> string option) -> ?id:string -> ?decipher:bool -> unit -> - t + exercise (** Writer and cipherer, ['a] can be [unit] *) val write: write_field:(string -> string -> 'a -> 'a) -> - t -> ?cipher:bool -> 'a -> + exercise -> ?cipher:bool -> bool -> 'a -> 'a (** Reader and decipherer with {!Lwt} *) val read_lwt: read_field:(string -> string option Lwt.t) -> ?id:string -> ?decipher:bool -> unit -> - t Lwt.t + exercise Lwt.t (** Writer and cipherer with {!Lwt}, ['a] can be [unit] *) val write_lwt: write_field:(string -> string -> 'a -> 'a Lwt.t) -> - t -> ?cipher:bool -> 'a -> + exercise -> ?cipher:bool -> bool -> 'a -> 'a Lwt.t (** JSON serializer, with {!id} file included *) diff --git a/src/repo/learnocaml_process_exercise_repository.ml b/src/repo/learnocaml_process_exercise_repository.ml index df2cbb627..61097d2da 100644 --- a/src/repo/learnocaml_process_exercise_repository.ml +++ b/src/repo/learnocaml_process_exercise_repository.ml @@ -52,14 +52,14 @@ let print_grader_error exercise = function | Error (-1) -> () | Error n -> Format.eprintf "[ERROR] %s: the solution has errors! (%d points%s)@." - Learnocaml_exercise.(access File.id exercise) + Learnocaml_exercise.(access true File.id exercise) n (if !Grader_cli.display_reports then "" else ". Run with '-v' to see the report") let spawn_grader dump_outputs dump_reports - ?print_result ?dirname meta exercise output_json = + ?print_result ?dirname meta exercise output_json (*TODO: double-check*)= let rec sleep () = if !n_processes <= 0 then Lwt_main.yield () >>= sleep @@ -76,12 +76,33 @@ let spawn_grader Grader_cli.display_callback := false; Lwt_main.run (Lwt.catch (fun () -> - Grader_cli.grade ?print_result ?dirname meta exercise output_json - >|= fun r -> - print_grader_error exercise r; - match r with - | Ok () -> exit 0 - | Error _ -> exit 1) + (match exercise with + | Learnocaml_exercise.Subexercise (exs) -> + (* match check_all_against with + | Some id -> + let exo = // Ici : trouver l'exercice du CAA + Lwt_list.map_p // Ici : noter tout à partir du CAA + | None -> *) + Lwt_list.map_p + (fun (exo,_subexs) -> Grader_cli.grade ?print_result ?dirname meta + (Learnocaml_exercise.Exercise exo) output_json) + exs + | exo -> Lwt_list.map_p + (fun exo -> Grader_cli.grade ?print_result ?dirname meta + exo output_json) + [exo] + ) + >|= fun l -> + let rec aux = function + | [] -> [] + | r :: l -> ( print_grader_error exercise r; r :: aux l) + in + let rec result = function + | Ok () :: l -> result l + | Error _ :: _ -> exit 1 + | [] -> exit 0 + in + result @@ aux l) (fun e -> Printf.eprintf "%!Grader error: %s\n%!" (Printexc.to_string e); exit 10)) @@ -89,8 +110,8 @@ let spawn_grader Lwt_unix.waitpid [] pid >>= fun (_pid, ret) -> incr n_processes; match ret with - | Unix.WEXITED 0 -> Lwt.return (Ok ()) - | _ -> Lwt.return (Error (-1)) + | Unix.WEXITED 0 -> Lwt.return ([Ok ()]) + | _ -> Lwt.return ([Error (-1)]) let main dest_dir = let exercises_index = @@ -113,11 +134,17 @@ let main dest_dir = String.sub f (String.length !exercises_dir + 1) (String.length f - String.length !exercises_dir - 1) in - if Sys.file_exists (f / "meta.json") then + if Sys.file_exists (f / "subindex.json") then match acc with - | None -> Some (Index.Exercises [full_id, None]) + | None -> Some (Index.Exercises [full_id, None, None]) | Some (Index.Exercises e) -> - Some (Index.Exercises (e @ [full_id, None])) + Some (Index.Exercises (e @ [full_id, None, None])) + | _ -> None + else if Sys.file_exists (f / "meta.json") then + match acc with + | None -> Some (Index.Exercises [full_id, None, None]) + | Some (Index.Exercises e) -> + Some (Index.Exercises (e @ [full_id, None, None])) | _ -> None else if Sys.is_directory f then match acc, auto_index f with @@ -148,6 +175,7 @@ let main dest_dir = (* Exercises must be unique, since their id refer to the directory. *) let rec fill_structure all_exercises = function | Index.Groups groups -> + print_string "fill_structure groups\n"; (* Ensures groups of a same parent are unique *) Lwt_list.fold_left_s (fun (all_exercises, subgroups, acc) (id, gr) -> @@ -163,21 +191,56 @@ let main dest_dir = >|= fun (all_exercises, _subgroups, groups) -> all_exercises, Index.Groups groups | Index.Exercises ids -> + print_string "fillstructure exe\n"; let filtered id = !exercises_filtered <> SSet.empty && not (SSet.mem id !exercises_filtered) in Lwt_list.fold_left_s - (fun (all_exercises, acc) (id, _) -> + (fun (all_exercises, acc) (id, _, _) -> if SMap.mem id all_exercises || filtered id then Lwt.return (all_exercises, acc) else - from_file Meta.enc + if Sys.file_exists (!exercises_dir / id / "subindex.json") then + (from_file (Subindex.enc) + (!exercises_dir / id / "subindex.json") + >>= fun meta -> + let subexercise_list = Exercise.Subindex.to_part meta + in + let rec aux = function + | [] -> [] + | part::l -> + let (_,subexercise,student_hidden,s_weight,t_weight) = + Exercise.Subindex.get_part_field part + in (id,subexercise,student_hidden,s_weight,t_weight,Some meta)::aux l + in + let listing = aux subexercise_list + in + let subexercises = + (Lwt_list.fold_left_s + (fun (acc) (sup_id,sub_id,s_hidden,s_weight,t_weight,_) -> + let long_id = (sup_id / sub_id) in + if SMap.mem long_id all_exercises || filtered long_id then + Lwt.return acc + else + read_exercise (!exercises_dir / long_id) + >|= fun exercise -> + print_string (long_id^"\n"); + let subexercise = Learnocaml_exercise.construct_subexercise long_id s_hidden s_weight t_weight + in + (exercise,subexercise) :: acc)) + ([]) (List.rev listing) + in subexercises >|= fun exercise -> + SMap.add id + (Learnocaml_exercise.Subexercise (exercise)) all_exercises, + (id, None, Some meta) :: acc) + else + (from_file (Meta.enc) (!exercises_dir / id / "meta.json") - >>= fun meta -> - read_exercise (!exercises_dir / id) - >|= fun exercise -> - SMap.add id exercise all_exercises, - (id, Some meta) :: acc) + >>= fun meta -> + read_exercise (!exercises_dir / id) + >|= fun exercise -> + SMap.add id (Learnocaml_exercise.Exercise exercise) all_exercises, + (id, Some meta, None) :: acc)) (all_exercises, []) (List.rev ids) >>= fun (all_exercises, exercises) -> Lwt.return (all_exercises, Index.Exercises exercises) @@ -196,41 +259,153 @@ let main dest_dir = let processes_arguments = List.rev @@ SMap.fold (fun id exercise acc -> - let exercise_dir = !exercises_dir / id in - let json_path = dest_dir / Learnocaml_index.exercise_path id in - let changed = try - let { Unix.st_mtime = json_time ; _ } = Unix.stat json_path in - Sys.readdir exercise_dir |> - Array.to_list |> - List.map (fun f -> (Unix.stat (exercise_dir / f)).Unix.st_mtime ) |> - List.exists (fun t -> t >= json_time) - with _ -> true in - let dump_outputs = - match !dump_outputs with - | None -> None - | Some dir -> Some (dir / id) in - let dump_reports = - match !dump_reports with - | None -> None - | Some dir -> Some (dir / id) in - (id, exercise_dir, exercise, json_path, - changed, dump_outputs, dump_reports) :: acc) + match exercise with + | Learnocaml_exercise.Exercise _ -> + let exercise_dir = !exercises_dir / id in + let json_path = dest_dir / Learnocaml_index.exercise_path id in + let changed = try + let { Unix.st_mtime = json_time ; _ } = Unix.stat json_path in + Sys.readdir exercise_dir |> + Array.to_list |> + List.map (fun f -> (Unix.stat (exercise_dir / f)).Unix.st_mtime ) |> + List.exists (fun t -> t >= json_time) + with _ -> true in + let dump_outputs = + match !dump_outputs with + | None -> None + | Some dir -> Some (dir / id) in + let dump_reports = + match !dump_reports with + | None -> None + | Some dir -> Some (dir / id) in + (id, exercise_dir, exercise, json_path, + changed, dump_outputs, dump_reports) :: acc + | Learnocaml_exercise.Subexercise (_) -> + + print_string ("multipartFile id : "^id^"\n"); + let exercise_dir = !exercises_dir / id in + print_string ("multipartFile exercise_dir : "^exercise_dir^"\n"); + let json_path = dest_dir / Learnocaml_index.exercise_path (id) in + print_string ("multipartFile json_path : "^json_path^"\n"); + + (*if you want to test a dynamic generation of the file_multipart .json, comment this code.*) + (*.. Statique generation of the file_multipart.json*) + let mutipart_file = open_out json_path in + Printf.fprintf mutipart_file "[\n"; + Printf.fprintf mutipart_file " {\n"; + Printf.fprintf mutipart_file " \"learnocaml_version\": \"2\", \n"; + Printf.fprintf mutipart_file " \"kind\": \"problem\", \n"; + Printf.fprintf mutipart_file " \"title\": \"Demo of a multi-part exercise\", \n"; + Printf.fprintf mutipart_file " \"stars\": 2, \n"; + Printf.fprintf mutipart_file " \"identifier\": \"demo-multi\", \n"; + Printf.fprintf mutipart_file " \"authors\": [[\"Someone\",\"someone@example.com\"]], \n"; + Printf.fprintf mutipart_file " \"focus\": [\"skill1\", \"skillN\", \"concept1\", \"conceptM\"], \n"; + Printf.fprintf mutipart_file " \"requirements\": [\"skill1\", \"skillN\", \"concept1\", \"conceptM\"], \n"; + Printf.fprintf mutipart_file " \"forward_exercises\": [\"exercise1\", \"exercise2\"], \n"; + Printf.fprintf mutipart_file " \"backward_exercises\": [\"exercise1\", \"exercise2\"] \n"; + Printf.fprintf mutipart_file " },\n"; + Printf.fprintf mutipart_file " [\n"; + Printf.fprintf mutipart_file " [ {\n"; + Printf.fprintf mutipart_file " \"id\": \"demoM-exo1\",\n"; + Printf.fprintf mutipart_file " \"prelude\": \"(* Some code is loaded in the toplevel before your code. *) let test = 11\",\n"; + Printf.fprintf mutipart_file " \"template\": \"let plus x y = x + y ;;let minus x y = y - x ;;let times x y = x *\",\n"; + Printf.fprintf mutipart_file " \"descr\": [\n[\n\"\",\n\"

The following example link will open another tab/window: OCaml
This exercise is just another demo for the exercise environment.
Test

HintUse an indirection.
\"\n]\n],\n"; + Printf.fprintf mutipart_file " \"prepare\": \"\",\n"; + Printf.fprintf mutipart_file " \"test\": \"jT9WIhcfkeK1Ged6sS7qoSYPTTgUSVZLPTxeWVXsfMAnr/pXVWCIG71HabyruvcloFTlVWNnvaHkIIwQeGLDgmkkS6Q6WhZIouAf9tVTMPIRLwUJ/PkRsDVVGdZx9SLaQO74qxQGW4LfNDqTTmFIdxrIdAPZXoWup65CnwaHriOM+kNj8ji2wYk9dT7eVeOXYmoBZ6EZGR/wEBFBV3vdsiiqDihBKZQRDGuSe4vfvzfXYOttLDfacr5Q/mr7Kg3bQ8YCUWJu5kaQcGXsmUhpdyoQ/Q+PgkGoI/V4/6+RXhRCng+x5lldqNAlOcNPMU8f7h7MVhlLBKC9V9nBjYLlLgcwSGjHHhLsnGy73PhCyZo8Wz2MER9Z+7oTRVo4cdLIOewBPVVxxFdHP4Xhq4zF2YwipDYtPPC5xUTZ1rkqlugA3lt4NlOECaThV3jEAGTn1UeBCwLyLqwwGkWMCcgtbkL9zevRB/8q6EsxyAN9HLOaovgG5QtVv+RNTIzp7fB9/yNTJMF+9rmWZLxzxpLs7jMIAo5RZB90JF/4QEOept5er9EcVWD0Xp6hw0jobaIwoCbU2i2bfvbmVs9Kx7OHt9IyE/670YdL9sgaeYQAFe1nGspA8g/RqDoVFs6Kf7LpB1OOa2IwQaKTYHK1ASsKbrrIgpyFT6WudAQBmJ7McEC+QkNs8pfSh15ps8r84+0ALQIZBVgXZ5tWUVZUW43eyETwDyEANJIQPVKsuLiehnDENJQEZ7+mxus49FajKgv5QycMBWI2zAqAr7qsbQBzw85DlBmDzVGdPFUWjEKRIqcA9dqolFp4qMtlMdFDMVmmdJOETwIHF0zsTTGAngX3PZZwUoeKT1+x6nuZ+P1ChJV8STZMZVoBTW9S2lB3bunB2PR0PkVejmpdPO7tqebv2xkplXk8Db+IxVaZE+Iu/bxHZVYrJEXISNjcMKPeE6rmN5a1AZLyLrcmGUOMCcgtu9C0jqiQTo+dlEdb6oYoUqvgosBG8BUVhOxZTITV8ukmpz9r0YkKje3BILZviQL5/WNBTUpRGWIZYQEDGRCsh155r99tRjm0SywhsvnkfOd5kDjUAzwn/h5=\",\n"; + Printf.fprintf mutipart_file " \"solution\": \"Y7CQUrhd9YADDxe6HYraL7YVTR6YVFoK+QlRHRCmfMERc5RwVSjSESYuu0GcdbMsoDjbMnYzfr0xCZBVgnrKq9xjDVFuO5==\",\n"; + Printf.fprintf mutipart_file " \"max-score\": 40,\n"; + Printf.fprintf mutipart_file " \"depend\": null,\n"; + Printf.fprintf mutipart_file " \"dependencies\": []\n"; + Printf.fprintf mutipart_file " },\n"; + Printf.fprintf mutipart_file " {\n"; + Printf.fprintf mutipart_file " \"sub_id\": \"demoM-exo1\",\n"; + Printf.fprintf mutipart_file " \"student_hidden\": false,\n"; + Printf.fprintf mutipart_file " \"student_weight\": 1,\n"; + Printf.fprintf mutipart_file " \"teacher_weight\": 0\n"; + Printf.fprintf mutipart_file " }\n"; + Printf.fprintf mutipart_file " ],\n"; + Printf.fprintf mutipart_file " [ {\n"; + Printf.fprintf mutipart_file " \"id\": \"demoM-exo2\",\n"; + Printf.fprintf mutipart_file " \"prelude\": \"(* Some code is loaded in the toplevel before your code. *) let test_subex_2 = 12\",\n"; + Printf.fprintf mutipart_file " \"template\": \"let plus_subex_2 x y = x + y ;;let minus x y = y - x ;;let times x y = x *\",\n"; + Printf.fprintf mutipart_file " \"descr\": [\n[\n\"\",\n\"

subex_2The following example link will open another tab/window: OCaml
This exercise is just another demo for the exercise environment.
Test

HintUse an indirection.
\"\n]\n],\n"; + Printf.fprintf mutipart_file " \"prepare\": \"\",\n"; + Printf.fprintf mutipart_file " \"test\": \"jT9WIhcfkeK1Ged6sS7qoSYPTTgUSVZLPTxeWVXsfMAnr/pXVWCIG71HabyruvcloFTlVWNnvaHkIIwQeGLDgmkkS6Q6WhZIouAf9tVTMPIRLwUJ/PkRsDVVGdZx9SLaQO74qxQGW4LfNDqTTmFIdxrIdAPZXoWup65CnwaHriOM+kNj8ji2wYk9dT7eVeOXYmoBZ6EZGR/wEBFBV3vdsiiqDihBKZQRDGuSe4vfvzfXYOttLDfacr5Q/mr7Kg3bQ8YCUWJu5kaQcGXsmUhpdyoQ/Q+PgkGoI/V4/6+RXhRCng+x5lldqNAlOcNPMU8f7h7MVhlLBKC9V9nBjYLlLgcwSGjHHhLsnGy73PhCyZo8Wz2MER9Z+7oTRVo4cdLIOewBPVVxxFdHP4Xhq4zF2YwipDYtPPC5xUTZ1rkqlugA3lt4NlOECaThV3jEAGTn1UeBCwLyLqwwGkWMCcgtbkL9zevRB/8q6EsxyAN9HLOaovgG5QtVv+RNTIzp7fB9/yNTJMF+9rmWZLxzxpLs7jMIAo5RZB90JF/4QEOept5er9EcVWD0Xp6hw0jobaIwoCbU2i2bfvbmVs9Kx7OHt9IyE/670YdL9sgaeYQAFe1nGspA8g/RqDoVFs6Kf7LpB1OOa2IwQaKTYHK1ASsKbrrIgpyFT6WudAQBmJ7McEC+QkNs8pfSh15ps8r84+0ALQIZBVgXZ5tWUVZUW43eyETwDyEANJIQPVKsuLiehnDENJQEZ7+mxus49FajKgv5QycMBWI2zAqAr7qsbQBzw85DlBmDzVGdPFUWjEKRIqcA9dqolFp4qMtlMdFDMVmmdJOETwIHF0zsTTGAngX3PZZwUoeKT1+x6nuZ+P1ChJV8STZMZVoBTW9S2lB3bunB2PR0PkVejmpdPO7tqebv2xkplXk8Db+IxVaZE+Iu/bxHZVYrJEXISNjcMKPeE6rmN5a1AZLyLrcmGUOMCcgtu9C0jqiQTo+dlEdb6oYoUqvgosBG8BUVhOxZTITV8ukmpz9r0YkKje3BILZviQL5/WNBTUpRGWIZYQEDGRCsh155r99tRjm0SywhsvnkfOd5kDjUAzwn/h5=\",\n"; + Printf.fprintf mutipart_file " \"solution\": \"Y7CQUrhd9YADDxe6HYraL7YVTR6YVFoK+QlRHRCmfMERc5RwVSjSESYuu0GcdbMsoDjbMnYzfr0xCZBVgnrKq9xjDVFuO5==\",\n"; + Printf.fprintf mutipart_file " \"max-score\": 40,\n"; + Printf.fprintf mutipart_file " \"depend\": null,\n"; + Printf.fprintf mutipart_file " \"dependencies\": []\n"; + Printf.fprintf mutipart_file " },\n"; + Printf.fprintf mutipart_file " {\n"; + Printf.fprintf mutipart_file " \"sub_id\": \"demoM-exo2\",\n"; + Printf.fprintf mutipart_file " \"student_hidden\": false,\n"; + Printf.fprintf mutipart_file " \"student_weight\": 1,\n"; + Printf.fprintf mutipart_file " \"teacher_weight\": 0\n"; + Printf.fprintf mutipart_file " }\n"; + Printf.fprintf mutipart_file " ]\n"; + Printf.fprintf mutipart_file " ],\n"; + Printf.fprintf mutipart_file " null\n"; + Printf.fprintf mutipart_file "]\n"; + close_out mutipart_file; + (*..................*) + + let changed = try + let { Unix.st_mtime = json_time ; _ } = Unix.stat json_path in + Sys.readdir exercise_dir |> + Array.to_list |> + List.map (fun f -> (Unix.stat (exercise_dir / f)).Unix.st_mtime ) |> + List.exists (fun t -> t >= json_time) + with _ -> true in + let dump_outputs = + match !dump_outputs with + | None -> None + | Some dir -> Some (dir / id ) in + let dump_reports = + match !dump_reports with + | None -> None + | Some dir -> Some (dir / id ) in + (id, exercise_dir, exercise, json_path, + changed, dump_outputs, dump_reports) :: acc + ) all_exercises [] in begin let listmap, grade = if !n_processes = 1 then - Lwt_list.map_s, + (Lwt_list.map_s, fun dump_outputs dump_reports ?print_result ?dirname meta exercise json_path -> Grader_cli.dump_outputs := dump_outputs; Grader_cli.dump_reports := dump_reports; - Grader_cli.grade ?print_result ?dirname meta exercise json_path - >|= fun r -> print_grader_error exercise r; r + (match exercise with + | Learnocaml_exercise.Subexercise (exs) -> + Lwt_list.map_p + (fun (exo,_) -> + Grader_cli.grade ?print_result ?dirname meta + (Learnocaml_exercise.Exercise exo) json_path) + exs + >>= fun check_all_against_result -> + (Lwt_list.map_p + (fun (exo,_) -> Grader_cli.grade ?print_result ?dirname meta + (Learnocaml_exercise.Exercise exo) json_path) + exs) + >>= fun normal_result -> + Lwt.return @@ List.append check_all_against_result normal_result + | Learnocaml_exercise.Exercise (_) -> Lwt_list.map_p + (fun exo -> Grader_cli.grade ?print_result ?dirname meta + exo json_path) + [exercise] + ) + >|= fun l -> + let rec aux = function + | [] -> [] + | r :: l -> ( print_grader_error exercise r; r :: aux l) + in aux l ) else Lwt_list.map_p, spawn_grader in listmap (fun (id, ex_dir, exercise, json_path, changed, dump_outputs,dump_reports) -> + print_string ("ID : "^id^"\nEx_dir : "^ex_dir^"\n"); let dst_ex_dir = String.concat Filename.dir_sep [dest_dir; "static"; id] in Lwt_utils.mkdir_p dst_ex_dir >>= fun () -> Lwt_stream.iter_p (fun base -> @@ -244,15 +419,18 @@ let main dest_dir = Format.printf "%-24s (no changes)@." id ; Lwt.return true end else begin - grade dump_outputs dump_reports - ~dirname:(!exercises_dir / id) (Index.find index id) exercise (Some json_path) - >>= function - | Ok () -> - Format.printf "%-24s [OK]@." id ; - Lwt.return true - | Error _ -> - Format.printf "%-24s [FAILED]@." id ; - Lwt.return false + let meta = Index.find index id in + (*maybe test if is multi_part exercise or not*) + grade dump_outputs dump_reports + ~dirname:(!exercises_dir / id) meta exercise (Some json_path) + >>= function + | Ok () :: _ (* à changer *) -> + Format.printf "%-24s [OK]@." id ; + Lwt.return true + | Error _ :: _-> + Format.printf "%-24s [FAILED]@." id ; + Lwt.return false + | [] -> Lwt.return false end) processes_arguments end >>= fun results -> diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 2b2c00f88..f950d240c 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -179,7 +179,19 @@ let log conn api_req = flush oc let check_report exo report grade = - let max_grade = Learnocaml_exercise.(access File.max_score) exo in + let max_grade = match exo with + | Learnocaml_exercise.Subexercise (subexs) -> + let rec aux acc = function + | [] -> 0 + | (ex,subex) :: l -> + let open Learnocaml_exercise in + aux (acc + subex.student_weight * + (access true File.max_score (Exercise ex))) + l + in + aux 0 subexs + | ex -> Learnocaml_exercise.(access true File.max_score) ex + in let score, _ = Learnocaml_report.result report in score * 100 / max_grade = grade @@ -450,13 +462,17 @@ module Request_handler = struct lwt_fail (`Forbidden, "Forbidden") | Api.Exercise (Some token, id) -> + print_string ("Server_multipart_0 : "^id^"\n"); (Exercise.Status.is_open id token >>= function | `Open | `Deadline _ as o -> + lwt_catch_fail (fun () -> Exercise.Meta.get id >>= fun meta -> Exercise.get id >>= fun ex -> respond_json cache (meta, ex, match o with `Deadline t -> Some (max t 0.) | `Open -> None) + ) + (fun exn -> (`Not_found, Printexc.to_string exn)) | `Closed -> lwt_fail (`Forbidden, "Exercise closed")) | Api.Exercise (None, _) -> diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index f07866c25..58eae7416 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -334,7 +334,7 @@ module Conversions (Json: JSON_CODEC) = struct | Exercise_index None -> get ["exercise-index.json"] - | Exercise (Some token, id) -> + | Exercise (Some token, id) -> print_string ("Api_multipart_2_ : \n"); get ~token ("exercises" :: String.split_on_char '/' (id^".json")) | Exercise (None, id) -> get ("exercises" :: String.split_on_char '/' (id^".json")) @@ -456,16 +456,22 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | `GET, ["exercise-index.json"], token -> Exercise_index token |> k | `GET, ("exercises"::path), token -> + (* write code that processes the folder of multipart *) + print_string ("Api_multipart_0 : \n"); (match last path with | Some s when String.lowercase_ascii (Filename.extension s) = ".json" -> (match token with | Some token -> let id = Filename.chop_suffix (String.concat "/" path) ".json" in + print_string ("Api_multipart_2 : "^id^"\n"); Exercise (Some token, id) |> k | None -> Invalid_request "Missing token" |> k) | Some "" -> + (* build link json & token *) + print_string ("Api_multipart_1_0 : \n"); Static ["exercise.html"] |> k | _ -> + print_string ("Api_multipart_1_1 : \n"); Static ("static"::path) |> k) | `GET, ("description"::_), _token -> (* match token with diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index e7e009b85..8d4e6573f 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -478,6 +478,114 @@ module Exercise = struct end + module Subindex = struct + + type meta = Meta.t + + type part = { + subtitle: string; + subexercise: string; + student_hidden: bool; + student_weight: int; + teacher_weight: int + } + + type t = { + meta : meta; + check_all_against: string option; + parts: part list; + } + + let to_meta s = s.meta + + let to_check s = s.check_all_against + + let to_part s = s.parts + + let get_part_field p = + let + {subtitle; subexercise; student_hidden; + student_weight; teacher_weight} = p + in (subtitle, subexercise, student_hidden, + student_weight, teacher_weight) + + let to_subindex m c p = + let meta = m in + let check_all_against = c in + let parts = p in + {meta ; check_all_against ; parts} + + let enc = + let meta_enc = Meta.enc + in + let part_enc = + J.(obj5 + (req "subtitle" string) + (req "subexercise" string) + (dft "student_hidden" bool false) + (dft "student_weight" int 1) + (dft "teacher_weight" int 1)) + in + let exercise_enc = + J.(obj3 + (req "meta" meta_enc) + (opt "check_all_against" string) + (req "parts" (list part_enc))) + in + J.conv + (fun {meta; check_all_against; parts} -> + let parts = + let rec aux = function + | [] -> [] + | {subtitle; subexercise; student_hidden; + student_weight; teacher_weight} :: l -> + (subtitle, subexercise, student_hidden, + student_weight, teacher_weight) :: (aux l) + in aux parts + in + (meta, + check_all_against, + parts)) + (fun (meta,check_all_against, part) -> + let parts = + let rec aux = function + | [] -> [] + | (subtitle, subexercise, student_hidden, + student_weight, teacher_weight) :: l -> + {subtitle; subexercise; student_hidden; + student_weight; teacher_weight} :: (aux l) + in aux part + in + to_subindex meta check_all_against parts) + (enc_check_version_1 (exercise_enc)) + + let find t id = + let rec aux = function + | [] -> raise Not_found + | {subtitle; subexercise; student_hidden; + student_weight; teacher_weight}::l-> + if id = subtitle then + {subtitle; subexercise; student_hidden; + student_weight; teacher_weight} + else + aux l + in + aux (to_part t) + + let find_opt t id = try Some (find t id) with Not_found -> None + + let map_exercises f l = + (List.map (function + | (id, Some ex) -> + (id, Some (to_subindex + (to_meta ex) + (to_check ex) + (f l (to_part ex)))) + | x -> x) + l) + + end + module Status = struct type skill = [`Plus | `Minus] * string @@ -711,7 +819,7 @@ module Exercise = struct module Index = struct type t = - | Exercises of (id * Meta.t option) list + | Exercises of (id * Meta.t option * Subindex.t option) list | Groups of (string * group) list and group = { title : string; @@ -721,11 +829,14 @@ module Exercise = struct let exercise_enc = J.union [ J.case J.string - (function id, None -> Some id | _ -> None) - (fun id -> id, None); + (function id, None, None -> Some id | _ -> None) + (fun id -> id, None, None); J.case J.(tup2 string Meta.enc) - (function id, Some meta -> Some (id, meta) | _ -> None) - (fun (id, meta) -> id, Some meta); + (function id, Some meta, None -> Some (id, meta) | _ -> None) + (fun (id, meta) -> id, Some meta, None); + J.case J.(tup2 string Subindex.enc) + (function id, None, Some submeta -> Some (id, submeta) | _ -> None) + (fun (id, submeta) -> id, None, Some submeta); ] in let group_enc = @@ -771,9 +882,16 @@ module Exercise = struct | Groups ((_, g)::r) -> (try aux g.contents with Not_found -> aux (Groups r)) | Groups [] -> raise Not_found - | Exercises l -> (match List.assoc id l with - | None -> raise Not_found - | Some e -> e) + | Exercises l -> + let rec assoc_tup3 id = function + | [] -> raise Not_found + | (ex_id, meta, subindex) :: l -> + if compare ex_id id = 0 then (meta, subindex) else assoc_tup3 id l + in + (match assoc_tup3 id l with + | _ , Some subindex -> Subindex.to_meta subindex + | Some meta, _ -> meta + | None, _ -> raise Not_found) in aux t @@ -788,7 +906,7 @@ module Exercise = struct | Exercises l -> Exercises (List.map (function - | (id, Some ex) -> (id, Some (f id ex)) + | (id, Some ex, Some subindex) -> (id, Some (f id ex), Some subindex) | x -> x) l) @@ -806,8 +924,8 @@ module Exercise = struct @@ fun gs -> Groups gs |> k | Exercises l -> mapk_list [] (fun e k -> match e with - | (id, Some ex) -> - f id ex @@ fun ex -> (id, Some ex) |> k + | (id, Some ex, Some subindex) -> + f id ex @@ fun ex -> (id, Some ex, Some subindex) |> k | x -> x |> k) l @@ fun l -> Exercises l |> k @@ -819,7 +937,7 @@ module Exercise = struct acc gs | Exercises l -> List.fold_left (fun acc -> function - | (id, Some ex) -> f acc id ex + | (id, Some ex, Some _) -> f acc id ex | _ -> acc) acc l @@ -838,11 +956,12 @@ module Exercise = struct aux [] gs | Exercises l -> let rec aux acc = function - | (id, Some ex) :: r -> - (f id ex @@ function - | true -> aux ((id, Some ex) :: acc) r + | (id, Some ex, subindex) :: r -> + aux ((id, Some ex, subindex ) :: acc) r + | (id, None, subindex) :: r -> + (f id subindex @@ function + | true -> aux ((id, None, subindex ) :: acc) r | false -> aux acc r) - | (_, None) :: r -> aux acc r | [] -> k (Exercises (List.rev acc)) in aux [] l diff --git a/src/state/learnocaml_data.mli b/src/state/learnocaml_data.mli index 23e24790b..c90e91917 100644 --- a/src/state/learnocaml_data.mli +++ b/src/state/learnocaml_data.mli @@ -244,11 +244,50 @@ module Exercise: sig val enc: t Json_encoding.encoding end + + module Subindex : sig + + type meta = Meta.t + + type part = { + subtitle : string; + subexercise : string; + student_hidden : bool; + student_weight : int; + teacher_weight : int; + } + + type t = { + meta : meta; + check_all_against : string option; + parts : part list; + } + + val to_meta : t -> meta + + val to_check : t -> string option + + val to_part : t -> part list + + val get_part_field : part -> string * string * bool * int * int + + val to_subindex : meta -> string option -> part list -> t + + val enc : t Json_encoding.encoding + + val find : t -> string -> part + + val find_opt : t -> string -> part option + + val map_exercises : + (('a * t option) list -> part list -> part list) -> + ('a * t option) list -> ('a * t option) list + end module Index: sig type t = - | Exercises of (id * Meta.t option) list + | Exercises of (id * Meta.t option * Subindex.t option) list | Groups of (string * group) list and group = { title : string; @@ -264,7 +303,7 @@ module Exercise: sig val fold_exercises: ('a -> id -> Meta.t -> 'a) -> 'a -> t -> 'a - val filter: (id -> Meta.t -> bool) -> t -> t + val filter: (id -> Subindex.t option -> bool) -> t -> t (** CPS version of [map_exercises] *) val mapk_exercises: @@ -273,7 +312,7 @@ module Exercise: sig (t -> 'a) -> 'a (** CPS version of [filter] *) - val filterk: (id -> Meta.t -> (bool -> 'a) -> 'a) -> t -> (t -> 'a) -> 'a + val filterk: (id -> Subindex.t option -> (bool -> 'a) -> 'a) -> t -> (t -> 'a) -> 'a end diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 6e1ea61e9..5d98c1f2a 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -258,6 +258,13 @@ module Exercise = struct focus = Status.skills_focus m s } end + + module Subindex = struct + include Exercise.Subindex + + (*let get_from_subindex subindex = + Exercise.Subindex*) + end module Index = struct include Exercise.Index @@ -284,6 +291,7 @@ module Exercise = struct with type id := id and module Meta := Exercise.Meta and module Status := Exercise.Status + and module Subindex := Exercise.Subindex and module Index := Exercise.Index) let get id = diff --git a/src/state/learnocaml_store.mli b/src/state/learnocaml_store.mli index d3934e24b..cc825f853 100644 --- a/src/state/learnocaml_store.mli +++ b/src/state/learnocaml_store.mli @@ -80,6 +80,10 @@ module Exercise: sig include module type of struct include Exercise.Meta end val get: Exercise.id -> t Lwt.t end + + module Subindex: sig + include module type of struct include Exercise.Subindex end + end module Index: sig include module type of struct include Exercise.Index end @@ -102,6 +106,7 @@ module Exercise: sig include module type of struct include Exercise end with module Meta := Exercise.Meta and module Status := Exercise.Status + and module Subindex := Exercise.Subindex and module Index := Exercise.Index val get: id -> t Lwt.t diff --git a/src/utils/learnocaml_partition_create.ml b/src/utils/learnocaml_partition_create.ml index 8358c4922..fb4a57b6d 100644 --- a/src/utils/learnocaml_partition_create.ml +++ b/src/utils/learnocaml_partition_create.ml @@ -93,10 +93,10 @@ let asak_partition prof fun_name sol by_grade = let partition exo_name fun_name prof = Learnocaml_store.Exercise.get exo_name >>= fun exo -> - let prelude = Learnocaml_exercise.(access File.prelude exo) in - let prepare = Learnocaml_exercise.(decipher File.prepare exo) in + let prelude = Learnocaml_exercise.(access false File.prelude exo) in + let prepare = Learnocaml_exercise.(decipher false File.prepare exo) in let prelude = prelude ^ "\n" ^ prepare in - let solution = Learnocaml_exercise.(decipher File.solution exo) in + let solution = Learnocaml_exercise.(decipher false File.solution exo) in let solution = prelude ^ "\n" ^ solution in get_all_saves exo_name prelude >|= fun saves -> diff --git a/static/css/learnocaml_description.css b/static/css/learnocaml_description.css index 609db063a..de73a7d41 100644 --- a/static/css/learnocaml_description.css +++ b/static/css/learnocaml_description.css @@ -74,6 +74,10 @@ body { flex-direction : column; } +#learnocaml-exo-tab-text-iframe > iframe { + height : 100%; +} + /* -------------------- Prelude -------------------------------- */ #learnocaml-exo-tab-text-prelude { diff --git a/static/css/learnocaml_exercise.css b/static/css/learnocaml_exercise.css index 1517c8bf7..e8ec89445 100644 --- a/static/css/learnocaml_exercise.css +++ b/static/css/learnocaml_exercise.css @@ -69,7 +69,32 @@ body { top: 61px; } } +/* ------------------------- Navigation ----------------------------*/ +#learnocaml-exo-tab-navigation { + position: absolute; + z-index: 3; + display: flex; + flex-direction: row ; + border-bottom: 1px black solid; + background: #ddd; + padding: 0px; + flex: 0 0 auto; + width: 100%; + height:60px; +} +#learnocaml-exo-tab-navigation > button { + width: 20%; +} +#learnocaml-exo-tab-navigation > h4 { + width: 60%; + text-align:center; +} /* -------------------- tabs and tab buttons ---------------------- */ +#learnocaml-exo-tab { + top: 60px; + position: absolute; + height: 100px; +} #learnocaml-exo-tab-buttons { position: absolute; z-index: 999; @@ -126,8 +151,22 @@ body { #learnocaml-exo-button-editor { display: none; } + #learnocaml-exo-tab { + left: 800px; right: 0px; top: 0px; + } + #learnocaml-exo-tab-navigation { + height: 60px; + width: 100%; + border-bottom: 1px black solid; + position: absolute; + z-index: 3; + display: flex; + flex-direction: row; + background: #ddd; + padding: 0px; + } #learnocaml-exo-tab-buttons { - left: 800px; right: 0px; top: 0px; + left: 0px; right: 0px; top: 61px; } #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-toplevel { border-bottom: none; @@ -141,7 +180,7 @@ body { opacity: 1; } #learnocaml-exo-tabs > * { - left: 800px; top: 40px; right: 0px; bottom: 0px; + left: 800px; top: 101px; right: 0px; bottom: 0px; } #learnocaml-exo-tabs > #learnocaml-exo-tab-editor { width: 800px; left: 0; bottom: 0; top: 61px; @@ -154,6 +193,9 @@ body { #learnocaml-exo-toolbar { right: 0px; } + #learnocaml-exo-tab{ + width: 100%; + } #learnocaml-exo-tab-buttons { left: 0; right: 0px; } @@ -175,23 +217,31 @@ body { } @media (min-width: 550px) and (max-width: 1199px) { #learnocaml-exo-tab-buttons { - top: 60px; + top: 61px; } #learnocaml-exo-tabs > * { - top: 100px; + top: 161px; } } @media (max-width: 549px) { - #learnocaml-exo-tab-buttons { - top: 40px; - } - #learnocaml-exo-tabs > * { - top: 80px; - } + #learnocaml-exo-tab { + top:40px; + height:80px; + } + #learnocaml-exo-tab-navigation { + height:40px; + } + #learnocaml-exo-tab-navigation > h4 { + align-self:center; + } + #learnocaml-exo-tab-buttons { + top: 41px; + } + #learnocaml-exo-tabs > * { + top: 120px; + } } - /* -------------------- Prelude -------------------------------- */ - #learnocaml-exo-prelude { overflow: hidden; left: 0; diff --git a/static/description.html b/static/description.html index bca45fd33..cc53f6d91 100644 --- a/static/description.html +++ b/static/description.html @@ -59,6 +59,9 @@
+
+ diff --git a/static/exercise.html b/static/exercise.html index af7210b73..58b800c6c 100644 --- a/static/exercise.html +++ b/static/exercise.html @@ -55,18 +55,30 @@
-
- - - - - - - - +
+
+ +
+
+ + + + + + + + +
diff --git a/translations/fr.po b/translations/fr.po index 7aae463af..a0517f8ec 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -789,6 +789,10 @@ msgstr "Erreur dans le code." msgid "Cannot start the grader if your code does not typecheck." msgstr "La notation ne peut être lancée si le code ne compile pas." +#: File "src/app/learnocaml_exercise_main.ml", line 414, characters 33-45 +msgid "Grade everything!" +msgstr "Tout noter!" + #: File "src/app/learnocaml_student_view.ml", line 213, characters 24-54 msgid "Future assignment (starting " msgstr "Devoir à venir (à partir du "