Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 9 additions & 4 deletions Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -35,17 +35,22 @@ static/dune:
# Generates up-to-date translation template for lang % from the sources
LANGS = $(patsubst translations/%.po,%,$(wildcard translations/*.po))
translations/$(LANGS:=.pot):
@for f in $(LANGS); do echo >> translations/$$f.po; done
@rm -f translations/*.pot
@for f in $(LANGS); do \
echo >> translations/$$f.po; \
rm -f translations/$$f.pot; \
cp translations/$$f.po.header translations/$$f.pot; \
done
@${DUNE} clean ${DUNE_ARGS}
-rm -f ${INDEX_ODOC_PATH}
@DUMP_POT=1 ${DUNE} build ${DUNE_ARGS} -j 1
@for f in $(LANGS); do \
mv translations/$$f.pot translations/$$f.pot.bak; \
msguniq translations/$$f.pot.bak > translations/$$f.pot; \
rm translations/$$f.pot.bak; \
msguniq -t utf-8 translations/$$f.pot.bak > translations/$$f.pot \
&& rm translations/$$f.pot.bak; \
done

.PHONY: translations/$(LANGS:=.pot)

# Updates existing translations (.po) for the latest source template
update-%-translation: translations/%.pot
@msgmerge -U translations/$*.po translations/$*.pot
Expand Down
3 changes: 2 additions & 1 deletion src/app/dune
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,8 @@
learnocaml_toplevel
js_of_ocaml-ppx
ocplib_i18n)
(modules Learnocaml_teacher_tab
(modules Learnocaml_teacher_tab_doc
Learnocaml_teacher_tab
Learnocaml_index_main)
(preprocess (pps ppx_ocplib_i18n js_of_ocaml-ppx))
)
Expand Down
19 changes: 14 additions & 5 deletions src/app/learnocaml_common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -143,16 +143,25 @@ let confirm ~title ?(ok_label=[%i"OK"]) ?(cancel_label=[%i"Cancel"]) contents f
close_button cancel_label;
]

let ask_string ~title ?(ok_label=[%i"OK"]) contents =
let ask_string ~title ?(ok_label=[%i"OK"]) ?(may_cancel=true) contents =
let input_field =
H.input ~a:[
H.a_input_type `Text;
] ()
in
let result_t, up = Lwt.wait () in
ext_alert ~title (contents @ [input_field]) ~buttons:[
box_button ok_label (fun () -> Lwt.wakeup up @@ Manip.value input_field)
];
let validate _ =
Lwt.wakeup up @@ Manip.value input_field
in
Manip.Ev.onreturn input_field validate;
let buttons =
box_button ok_label validate
:: (if may_cancel
then [close_button [%i"Cancel"]]
else [])
in
ext_alert ~title (contents @ [input_field]) ~buttons;
Manip.focus input_field;
result_t

let default_exn_printer = function
Expand Down Expand Up @@ -1157,7 +1166,7 @@ let get_token ?(has_server = true) () =
Lwt.return
with
Not_found ->
ask_string ~title:"Token"
ask_string ~title:"Token" ~may_cancel:false
[H.txt [%i"Enter your token"]]
>>= fun input_tok ->
let token = Token.parse (input_tok) in
Expand Down
1 change: 1 addition & 0 deletions src/app/learnocaml_common.mli
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@ val confirm :
val ask_string :
title: string ->
?ok_label: string ->
?may_cancel: bool ->
[< Html_types.div_content > `Input] Tyxml_js.Html.elt list ->
string Lwt.t

Expand Down
145 changes: 102 additions & 43 deletions src/app/learnocaml_teacher_tab.ml
Original file line number Diff line number Diff line change
Expand Up @@ -68,22 +68,46 @@ let tag_addremove list_id placeholder add_fun remove_fun =
] [ H.txt "\xe2\x9e\x96" (* U+2796 heavy minus sign *) ];
]

let help_button name (title,md_text) =
let dialog () =
let text_div =
let d =
H.div []
~a:[H.a_class ["doc-popup-body"]]
in
(* Manip.SetCss.maxHeight d "85vh";
* Manip.SetCss.overflowY d "auto"; *)
let doc_html_string =
Omd.(md_text |> of_string |> to_html)
in
Manip.setInnerHtml d doc_html_string;
d
in
Learnocaml_common.ext_alert ~title [text_div]
in
H.button ~a:[
H.a_id ("button_help_"^name);
H.a_onclick (fun _ -> dialog (); true);
H.a_style "margin-left: 1em;";
] [H.txt "?"]

let rec teacher_tab token _select _params () =
let action_new_token () =
retrieve (Learnocaml_api.Create_teacher_token token)
Learnocaml_common.ask_string
~title:"NEW TEACHER TOKEN"
[H.txt @@ "Enter a nickname for the new token:"]
>>= fun nickname ->
let nick = match String.trim nickname with
| "" -> None
| s -> Some s
in
retrieve (Learnocaml_api.Create_teacher_token (token, nick))
>|= fun new_token ->
alert ~title:[%i"TEACHER TOKEN"]
(Printf.sprintf [%if"New teacher token created:\n%s\n\n\
write it down."]
(Token.to_string new_token))
in
let action_csv_export () =
retrieve (Learnocaml_api.Students_csv (token, [], []))
>|= fun csv ->
Learnocaml_common.fake_download
~name:"learnocaml.csv"
~contents:(Js.string csv)
in
let indent_style lvl =
H.a_style (Printf.sprintf "text-align: left; padding-left: %dem;" lvl)
in
Expand Down Expand Up @@ -183,6 +207,23 @@ let rec teacher_tab token _select _params () =
let assignment_change = ref (fun _ -> assert false) in
let assignment_remove = ref (fun _ -> assert false) in

let action_csv_export () =
let exercises =
Hashtbl.to_seq_keys selected_exercises |>
List.of_seq
in
let students =
Hashtbl.to_seq_keys selected_students |>
Seq.filter_map (function `Token tk -> Some tk | `Any -> None) |>
List.of_seq
in
retrieve (Learnocaml_api.Students_csv (token, exercises, students))
>|= fun csv ->
Learnocaml_common.fake_download
~name:"learnocaml.csv"
~contents:(Js.string csv)
in

(* Exercises table *)
let rec mk_table group_level acc status group =
match group with
Expand Down Expand Up @@ -211,7 +252,7 @@ let rec teacher_tab token _select _params () =
in
let open_partition_ () =
Lwt.async (fun () ->
ask_string ~title:"Choose a function name"
ask_string ~title:"Partitioning of student solutions"
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am not sure that's a valid patch: we really want to ask a function name here.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The question is below, this is only the title of the dialog. My reason for this change is that you get there by ctrl-click on an exercise (i.e. not an explicit button) and previously you may get pretty confused as to what this was about.
image

[H.txt @@ "Choose a function name to partition codes from "^ id ^": "]
>|= fun funname ->
let _win =
Expand Down Expand Up @@ -258,12 +299,13 @@ let rec teacher_tab token _select _params () =
H.td [stars_div meta.Exercise.Meta.stars];
H.td [
let cls, text =
if Token.Map.is_empty ES.(st.assignments.token_map) then
match ES.(st.assignments.default) with
| ES.Open -> "exo_open", [%i"Open"]
| ES.Closed -> "exo_closed", [%i"Closed"]
| ES.Assigned _ -> "exo_assigned", [%i"Assigned"]
else "exo_assigned", [%i"Assigned"]
match Token.Map.is_empty ES.(st.assignments.token_map),
ES.(st.assignments.default) with
| true, ES.Open -> "exo_open", [%i"Open"]
| true, ES.Closed -> "exo_closed", [%i"Closed"]
| _, (ES.Assigned _ | ES.Closed) ->
"exo_assigned", [%i"Assigned"]
| false, ES.Open -> "exo_assigned", [%i"Open/Assg"]
in
H.span ~a:[H.a_class [cls]] [H.txt text]
];
Expand Down Expand Up @@ -328,11 +370,14 @@ let rec teacher_tab token _select _params () =
let exercise_skills_list_id = "exercise_skills_list" in
let exercises_div =
let legend =
H.legend ~a:[
H.a_onclick (fun _ ->
!toggle_selected_exercises (all_exercises !exercises_index);
true);
] [H.txt [%i"Exercises"]; H.txt " \xe2\x98\x90" (* U+2610 *)]
H.legend [
H.span
[ H.txt [%i"Exercises"]; H.txt " \xe2\x98\x90" (* U+2610 *) ]
~a:[H.a_onclick (fun _ ->
!toggle_selected_exercises (all_exercises !exercises_index);
true)];
help_button "exercises" Learnocaml_teacher_tab_doc.exercises_pane_md
]
in
H.div ~a:[H.a_id "exercises_pane"; H.a_class ["learnocaml_pane"]] [
H.div ~a:[H.a_id "exercises_filter_box"] [
Expand Down Expand Up @@ -530,23 +575,26 @@ let rec teacher_tab token _select _params () =
in
let students_div =
let legend =
H.legend ~a:[
H.a_onclick (fun _ ->
let all =
Token.Map.fold (fun k _ acc -> (`Token k)::acc)
!students_map [`Any]
in
let all =
List.filter (fun t ->
not (Manip.hasClass (find_component (student_line_id t))
"student_hidden"))
all
in
!toggle_selected_students all;
true
);
] [H.txt [%i"Students"];
H.txt " \xe2\x98\x90" (* U+2610 ballot box *)]
H.legend [
H.span
[ H.txt [%i"Students"];
H.txt " \xe2\x98\x90" (* U+2610 ballot box *) ]
~a:[H.a_onclick (fun _ ->
let all =
Token.Map.fold (fun k _ acc -> (`Token k)::acc)
!students_map [`Any]
in
let all =
List.filter (fun t ->
not (Manip.hasClass (find_component (student_line_id t))
"student_hidden"))
all
in
!toggle_selected_students all;
true
)];
help_button "students" Learnocaml_teacher_tab_doc.students_pane_md
]
in
H.div ~a:[H.a_id "students_pane"; H.a_class ["learnocaml_pane"]] [
H.div ~a:[H.a_id "students_filter_box"] [
Expand Down Expand Up @@ -812,12 +860,10 @@ let rec teacher_tab token _select _params () =
ES.(default_assignment st.assignments = Open))
ids
then ES.(fun assg ->
(* fixme: invisible change if the exercise is assigned! *)
match default_assignment assg with
| Open -> set_default_assignment assg Closed
| _ -> assg)
else ES.(fun assg ->
(* fixme: invisible change if the exercise is assigned! *)
match default_assignment assg with
| Closed -> set_default_assignment assg Open
| _ -> assg)
Expand All @@ -841,9 +887,16 @@ let rec teacher_tab token _select _params () =
Manip.appendChild exercises_div exercise_control_div;
let assignments_div = H.div [] in
let control_div =
let legend =
H.legend [
H.txt [%i"Assignments"];
help_button "assignments"
Learnocaml_teacher_tab_doc.assignments_pane_md
]
in
H.div ~a:[H.a_id "control_pane"] [
H.fieldset
~legend:(H.legend [H.txt [%i"Assignments"]])
~legend
[assignments_div];
]
in
Expand Down Expand Up @@ -932,7 +985,7 @@ let rec teacher_tab token _select _params () =
H.li ~a: [ H.a_onclick (fun _ -> Lwt.async action_new_token; true) ]
[ H.txt [%i"Create new teacher token"] ];
H.li ~a: [ H.a_onclick (fun _ -> Lwt.async action_csv_export; true) ]
[ H.txt [%i"Download student data as CSV"] ];
[ H.txt [%i"Download the data for selected students/exercises as CSV"] ];
]
];
]
Expand Down Expand Up @@ -1102,10 +1155,16 @@ let rec teacher_tab token _select _params () =
if SMap.is_empty !status_changes &&
Token.Map.is_empty !students_changes then
(Manip.replaceChildren status_text_div [];
Manip.removeClass status_text_div "warning")
Manip.removeClass status_text_div "warning";
Option.iter
(fun b -> Manip.removeClass b "warning")
(Manip.by_id "button_apply"))
else
(Manip.replaceChildren status_text_div [H.txt [%i"Unsaved changes"]];
Manip.addClass status_text_div "warning")
Manip.addClass status_text_div "warning";
Option.iter
(fun b -> Manip.addClass b "warning")
(Manip.by_id "button_apply"))
end;
toggle_selected_exercises := begin
fun ?force ?(update = force=None) ids ->
Expand Down
Loading