diff --git a/src/haz3lschool/Grading.re b/src/haz3lschool/Grading.re index 016000c6d5..c13f35cb75 100644 --- a/src/haz3lschool/Grading.re +++ b/src/haz3lschool/Grading.re @@ -1,7 +1,7 @@ open Haz3lcore; open Sexplib.Std; -open Virtual_dom.Vdom; -open Node; +// open Virtual_dom.Vdom; +// open Node; module F = (ExerciseEnv: Exercise.ExerciseEnv) => { open Exercise.F(ExerciseEnv); @@ -308,313 +308,312 @@ module F = (ExerciseEnv: Exercise.ExerciseEnv) => { (total_points, max_points); }; }; -}; +} /* }*/; // NEW MODULE FOR DOCUMENTATION MODE / TUTORIAL SYSTEM -module D = (DocEnv: DocumentationEnv.DocEnv) => { - open DocumentationEnv.D(DocEnv); - - [@deriving (show({with_path: false}), sexp, yojson)] - type percentage = float; - [@deriving (show({with_path: false}), sexp, yojson)] - type points = float; - [@deriving (show({with_path: false}), sexp, yojson)] - type score = (points, points); - - let score_of_percent = (percent, max_points) => { - let max_points = float_of_int(max_points); - (percent *. max_points, max_points); - }; - - module TestValidationReport = { - type t = { - test_results: option(TestResults.t), - required: int, - provided: int, - }; - - let mk = (eds: eds, test_results: option(TestResults.t)) => { - { - test_results, - required: eds.your_tests.required, - provided: eds.your_tests.provided, - }; - }; - - let percentage = (report: t): percentage => { - switch (report.test_results) { - | None => 0.0 - | Some(test_results) => - let num_tests = float_of_int(test_results.total); - let required = float_of_int(report.required); - let provided = float_of_int(report.provided); - let num_passing = float_of_int(test_results.passing); - - required -. provided <= 0.0 || num_tests <= 0.0 - ? 0.0 - : num_passing - /. num_tests - *. ( - Float.max( - 0., - Float.min(num_tests -. provided, required -. provided), - ) - /. (required -. provided) - ); - }; - }; - - let test_summary_str = (test_results: TestResults.t) => { - TestResults.result_summary_str( - ~n=test_results.total, - ~p=test_results.failing, - ~q=test_results.unfinished, - ~n_str="test", - ~ns_str="tests", - ~p_str="failing", - ~q_str="indeterminate", - ~r_str="valid", - ); - }; - }; - - module MutationTestingReport = { - type t = {results: list((TestStatus.t, string))}; - - let hidden_bug_status = - ( - test_validation_data: DynamicsItem.t, - hidden_bug_data: DynamicsItem.t, - ) - : TestStatus.t => { - switch ( - ModelResult.test_results(test_validation_data.result), - ModelResult.test_results(hidden_bug_data.result), - ) { - | (None, _) - | (_, None) => Indet - | (Some(test_validation_data), Some(hidden_bug_data)) => - let validation_test_map = test_validation_data.test_map; - let hidden_bug_test_map = hidden_bug_data.test_map; - - let found = - hidden_bug_test_map - |> List.find_opt(((id, instance_reports)) => { - let status = TestMap.joint_status(instance_reports); - switch (status) { - | TestStatus.Pass - | TestStatus.Indet => false - | TestStatus.Fail => - let validation_test_reports = - validation_test_map |> TestMap.lookup(id); - switch (validation_test_reports) { - | None => false - | Some(reports) => - let status = TestMap.joint_status(reports); - switch (status) { - | TestStatus.Pass => true - | TestStatus.Fail - | TestStatus.Indet => false - }; - }; - }; - }); - switch (found) { - | None => Fail - | Some(_) => Pass - }; - }; - }; // for each hidden bug - // in the test results data, find a test ID that passes test validation but fails against - - let mk = - ( - ~test_validation: DynamicsItem.t, - ~hidden_bugs_state: list(wrong_impl(Editor.t)), - ~hidden_bugs: list(DynamicsItem.t), - ) - : t => { - let results = - List.map(hidden_bug_status(test_validation), hidden_bugs); - let hints = - List.map( - (wrong_impl: wrong_impl(Editor.t)) => wrong_impl.hint, - hidden_bugs_state, - ); - let results = List.combine(results, hints); - {results: results}; - }; - - let percentage = (report: t): percentage => { - let results = report.results; - let num_wrong_impls = List.length(results); - let num_passed = - results - |> List.find_all(((status, _)) => status == TestStatus.Pass) - |> List.length; - switch (num_wrong_impls) { - | 0 => 1.0 - | _ => float_of_int(num_passed) /. float_of_int(num_wrong_impls) - }; - }; - - // TODO move to separate module - - let summary_str = (~total, ~found): string => { - TestResults.result_summary_str( - ~n=total, - ~p=found, - ~q=0, - ~n_str="bug", - ~ns_str="bugs", - ~p_str="exposed", - ~q_str="", - ~r_str="unrevealed", - ); - }; - }; - - module SyntaxReport = { - type t = { - hinted_results: list((bool, hint)), - percentage, - }; - - let mk = (~your_impl: Editor.t, ~tests: syntax_tests): t => { - let user_impl_term = your_impl.state.meta.view_term; - - let predicates = - List.map(((_, p)) => SyntaxTest.predicate_fn(p), tests); - let hints = List.map(((h, _)) => h, tests); - let syntax_results = SyntaxTest.check(user_impl_term, predicates); - - { - hinted_results: - List.map2((r, h) => (r, h), syntax_results.results, hints), - percentage: syntax_results.percentage, - }; - }; - }; - - module ImplGradingReport = { - type t = { - hints: list(string), - test_results: option(TestResults.t), - hinted_results: list((TestStatus.t, string)), - }; - - let mk = (~hints: list(string), ~test_results: option(TestResults.t)): t => { - let hinted_results = - switch (test_results) { - | Some(test_results) => - let statuses = test_results.statuses; - Util.ListUtil.zip_defaults( - statuses, - hints, - Haz3lcore.TestStatus.Indet, - "No hint available.", - ); - - | None => - Util.ListUtil.zip_defaults( - [], - hints, - Haz3lcore.TestStatus.Indet, - "Exercise configuration error: Hint without a test.", - ) - }; - {hints, test_results, hinted_results}; - }; - - let total = (report: t) => List.length(report.hinted_results); - let num_passed = (report: t) => { - report.hinted_results - |> List.find_all(((status, _)) => status == TestStatus.Pass) - |> List.length; - }; - - let percentage = (report: t, syntax_report: SyntaxReport.t): percentage => { - syntax_report.percentage - *. (float_of_int(num_passed(report)) /. float_of_int(total(report))); - }; - - let test_summary_str = (test_results: TestResults.t) => { - TestResults.result_summary_str( - ~n=test_results.total, - ~p=test_results.failing, - ~q=test_results.unfinished, - ~n_str="test", - ~ns_str="tests", - ~p_str="failing", - ~q_str="indeterminate", - ~r_str="valid", - ); - }; - }; - - module GradingReport = { - type t = { - point_distribution, - test_validation_report: TestValidationReport.t, - mutation_testing_report: MutationTestingReport.t, - syntax_report: SyntaxReport.t, - impl_grading_report: ImplGradingReport.t, - }; - - let mk = (eds: eds, ~stitched_dynamics: stitched(DynamicsItem.t)) => { - point_distribution: eds.point_distribution, - test_validation_report: - TestValidationReport.mk( - eds, - ModelResult.test_results(stitched_dynamics.test_validation.result), - ), - mutation_testing_report: - MutationTestingReport.mk( - ~test_validation=stitched_dynamics.test_validation, - ~hidden_bugs_state=eds.hidden_bugs, - ~hidden_bugs=stitched_dynamics.hidden_bugs, - ), - syntax_report: - SyntaxReport.mk(~your_impl=eds.your_impl, ~tests=eds.syntax_tests), - impl_grading_report: - ImplGradingReport.mk( - ~hints=eds.hidden_tests.hints, - ~test_results= - ModelResult.test_results(stitched_dynamics.hidden_tests.result), - ), - }; - - let overall_score = - ( - { - point_distribution, - test_validation_report, - mutation_testing_report, - syntax_report, - impl_grading_report, - _, - }: t, - ) - : score => { - let (tv_points, tv_max) = - score_of_percent( - TestValidationReport.percentage(test_validation_report), - point_distribution.test_validation, - ); - let (mt_points, mt_max) = - score_of_percent( - MutationTestingReport.percentage(mutation_testing_report), - point_distribution.mutation_testing, - ); - let (ig_points, ig_max) = - score_of_percent( - ImplGradingReport.percentage(impl_grading_report, syntax_report), - point_distribution.impl_grading, - ); - let total_points = tv_points +. mt_points +. ig_points; - let max_points = tv_max +. mt_max +. ig_max; - (total_points, max_points); - }; - }; -}; \ No newline at end of file +// module D = (DocEnv: DocumentationEnv.DocEnv) => { +// open DocumentationEnv.D(DocEnv); + +// // [@deriving (show({with_path: false}), sexp, yojson)] +// // type percentage = float; +// // [@deriving (show({with_path: false}), sexp, yojson)] +// // type points = float; +// // [@deriving (show({with_path: false}), sexp, yojson)] +// // type score = (points, points); + +// // let score_of_percent = (percent, max_points) => { +// // let max_points = float_of_int(max_points); +// // (percent *. max_points, max_points); +// // }; + +// // module TestValidationReport = { +// // type t = { +// // test_results: option(TestResults.t), +// // required: int, +// // provided: int, +// // }; + +// let mk = (eds: eds, test_results: option(TestResults.t)) => { +// { +// test_results, +// required: eds.your_tests.required, +// provided: eds.your_tests.provided, +// }; +// }; + +// let percentage = (report: t): percentage => { +// switch (report.test_results) { +// | None => 0.0 +// | Some(test_results) => +// let num_tests = float_of_int(test_results.total); +// let required = float_of_int(report.required); +// let provided = float_of_int(report.provided); +// let num_passing = float_of_int(test_results.passing); + +// required -. provided <= 0.0 || num_tests <= 0.0 +// ? 0.0 +// : num_passing +// /. num_tests +// *. ( +// Float.max( +// 0., +// Float.min(num_tests -. provided, required -. provided), +// ) +// /. (required -. provided) +// ); +// }; +// }; + +// let test_summary_str = (test_results: TestResults.t) => { +// TestResults.result_summary_str( +// ~n=test_results.total, +// ~p=test_results.failing, +// ~q=test_results.unfinished, +// ~n_str="test", +// ~ns_str="tests", +// ~p_str="failing", +// ~q_str="indeterminate", +// ~r_str="valid", +// ); +// }; +// }; + +// module MutationTestingReport = { +// type t = {results: list((TestStatus.t, string))}; + +// let hidden_bug_status = +// ( +// test_validation_data: DynamicsItem.t, +// hidden_bug_data: DynamicsItem.t, +// ) +// : TestStatus.t => { +// switch ( +// ModelResult.test_results(test_validation_data.result), +// ModelResult.test_results(hidden_bug_data.result), +// ) { +// | (None, _) +// | (_, None) => Indet +// | (Some(test_validation_data), Some(hidden_bug_data)) => +// let validation_test_map = test_validation_data.test_map; +// let hidden_bug_test_map = hidden_bug_data.test_map; + +// let found = +// hidden_bug_test_map +// |> List.find_opt(((id, instance_reports)) => { +// let status = TestMap.joint_status(instance_reports); +// switch (status) { +// | TestStatus.Pass +// | TestStatus.Indet => false +// | TestStatus.Fail => +// let validation_test_reports = +// validation_test_map |> TestMap.lookup(id); +// switch (validation_test_reports) { +// | None => false +// | Some(reports) => +// let status = TestMap.joint_status(reports); +// switch (status) { +// | TestStatus.Pass => true +// | TestStatus.Fail +// | TestStatus.Indet => false +// }; +// }; +// }; +// }); +// switch (found) { +// | None => Fail +// | Some(_) => Pass +// }; +// }; +// }; // for each hidden bug +// // in the test results data, find a test ID that passes test validation but fails against + +// let mk = +// ( +// ~test_validation: DynamicsItem.t, +// ~hidden_bugs_state: list(wrong_impl(Editor.t)), +// ~hidden_bugs: list(DynamicsItem.t), +// ) +// : t => { +// let results = +// List.map(hidden_bug_status(test_validation), hidden_bugs); +// let hints = +// List.map( +// (wrong_impl: wrong_impl(Editor.t)) => wrong_impl.hint, +// hidden_bugs_state, +// ); +// let results = List.combine(results, hints); +// {results: results}; +// }; + +// let percentage = (report: t): percentage => { +// let results = report.results; +// let num_wrong_impls = List.length(results); +// let num_passed = +// results +// |> List.find_all(((status, _)) => status == TestStatus.Pass) +// |> List.length; +// switch (num_wrong_impls) { +// | 0 => 1.0 +// | _ => float_of_int(num_passed) /. float_of_int(num_wrong_impls) +// }; +// }; + +// // TODO move to separate module + +// let summary_str = (~total, ~found): string => { +// TestResults.result_summary_str( +// ~n=total, +// ~p=found, +// ~q=0, +// ~n_str="bug", +// ~ns_str="bugs", +// ~p_str="exposed", +// ~q_str="", +// ~r_str="unrevealed", +// ); +// }; +// }; + +// module SyntaxReport = { +// type t = { +// hinted_results: list((bool, hint)), +// percentage, +// }; + +// let mk = (~your_impl: Editor.t, ~tests: syntax_tests): t => { +// let user_impl_term = your_impl.state.meta.view_term; + +// let predicates = +// List.map(((_, p)) => SyntaxTest.predicate_fn(p), tests); +// let hints = List.map(((h, _)) => h, tests); +// let syntax_results = SyntaxTest.check(user_impl_term, predicates); + +// { +// hinted_results: +// List.map2((r, h) => (r, h), syntax_results.results, hints), +// percentage: syntax_results.percentage, +// }; +// }; +// }; + +// module ImplGradingReport = { +// type t = { +// hints: list(string), +// test_results: option(TestResults.t), +// hinted_results: list((TestStatus.t, string)), +// }; + +// let mk = (~hints: list(string), ~test_results: option(TestResults.t)): t => { +// let hinted_results = +// switch (test_results) { +// | Some(test_results) => +// let statuses = test_results.statuses; +// Util.ListUtil.zip_defaults( +// statuses, +// hints, +// Haz3lcore.TestStatus.Indet, +// "No hint available.", +// ); + +// | None => +// Util.ListUtil.zip_defaults( +// [], +// hints, +// Haz3lcore.TestStatus.Indet, +// "Exercise configuration error: Hint without a test.", +// ) +// }; +// {hints, test_results, hinted_results}; +// }; + +// let total = (report: t) => List.length(report.hinted_results); +// let num_passed = (report: t) => { +// report.hinted_results +// |> List.find_all(((status, _)) => status == TestStatus.Pass) +// |> List.length; +// }; + +// let percentage = (report: t, syntax_report: SyntaxReport.t): percentage => { +// syntax_report.percentage +// *. (float_of_int(num_passed(report)) /. float_of_int(total(report))); +// }; + +// let test_summary_str = (test_results: TestResults.t) => { +// TestResults.result_summary_str( +// ~n=test_results.total, +// ~p=test_results.failing, +// ~q=test_results.unfinished, +// ~n_str="test", +// ~ns_str="tests", +// ~p_str="failing", +// ~q_str="indeterminate", +// ~r_str="valid", +// ); +// }; +// }; + +// module GradingReport = { +// type t = { +// point_distribution, +// test_validation_report: TestValidationReport.t, +// mutation_testing_report: MutationTestingReport.t, +// syntax_report: SyntaxReport.t, +// impl_grading_report: ImplGradingReport.t, +// }; + +// let mk = (eds: eds, ~stitched_dynamics: stitched(DynamicsItem.t)) => { +// point_distribution: eds.point_distribution, +// test_validation_report: +// TestValidationReport.mk( +// eds, +// ModelResult.test_results(stitched_dynamics.test_validation.result), +// ), +// mutation_testing_report: +// MutationTestingReport.mk( +// ~test_validation=stitched_dynamics.test_validation, +// ~hidden_bugs_state=eds.hidden_bugs, +// ~hidden_bugs=stitched_dynamics.hidden_bugs, +// ), +// syntax_report: +// SyntaxReport.mk(~your_impl=eds.your_impl, ~tests=eds.syntax_tests), +// impl_grading_report: +// ImplGradingReport.mk( +// ~hints=eds.hidden_tests.hints, +// ~test_results= +// ModelResult.test_results(stitched_dynamics.hidden_tests.result), +// ), +// }; + +// let overall_score = +// ( +// { +// point_distribution, +// test_validation_report, +// mutation_testing_report, +// syntax_report, +// impl_grading_report, +// _, +// }: t, +// ) +// : score => { +// let (tv_points, tv_max) = +// score_of_percent( +// TestValidationReport.percentage(test_validation_report), +// point_distribution.test_validation, +// ); +// let (mt_points, mt_max) = +// score_of_percent( +// MutationTestingReport.percentage(mutation_testing_report), +// point_distribution.mutation_testing, +// ); +// let (ig_points, ig_max) = +// score_of_percent( +// ImplGradingReport.percentage(impl_grading_report, syntax_report), +// point_distribution.impl_grading, +// ); +// let total_points = tv_points +. mt_points +. ig_points; +// let max_points = tv_max +. mt_max +. ig_max; +// (total_points, max_points); +// }; +// }; diff --git a/src/haz3lweb/Grading.re b/src/haz3lweb/Grading.re index ac7414a5a1..7148ca1644 100644 --- a/src/haz3lweb/Grading.re +++ b/src/haz3lweb/Grading.re @@ -1,463 +1,619 @@ +open Haz3lcore; +open Sexplib.Std; open Virtual_dom.Vdom; open Node; -include Haz3lschool.Grading.F(Exercise.ExerciseEnv); - -let score_view = ((earned: points, max: points)) => { - div( - ~attr= - Attr.classes([ - "test-percent", - Float.equal(earned, max) ? "all-pass" : "some-fail", - ]), - [text(Printf.sprintf("%.1f / %.1f pts", earned, max))], - ); -}; - -let percentage_view = (p: percentage) => { - div( - ~attr= - Attr.classes([ - "test-percent", - Float.equal(p, 1.) ? "all-pass" : "some-fail", - ]), - [text(Printf.sprintf("%.0f%%", 100. *. p))], - ); -}; - -module TestValidationReport = { - include TestValidationReport; - let textual_summary = (report: t) => { - switch (report.test_results) { - | None => [Node.text("No test results")] - | Some(test_results) => [ - { - let total_tests = test_results.total; - let required = report.required; - let num_tests_message = - total_tests >= required - ? "at least " ++ string_of_int(required) - : string_of_int(test_results.total) - ++ " of " - ++ string_of_int(report.required); - text( - "Entered " - ++ num_tests_message - ++ " tests. " - ++ test_summary_str(test_results), - ); - }, - ] - }; - }; +module F = (ExerciseEnv: Exercise.ExerciseEnv) => { + open Exercise.F(ExerciseEnv); - let view = (~inject, report: t, max_points: int) => { - Cell.report_footer_view([ - div( - ~attr=Attr.classes(["test-summary"]), - [ - div( - ~attr=Attr.class_("test-text"), - [score_view(score_of_percent(percentage(report), max_points))] - @ textual_summary(report), - ), - ] - @ Option.to_list( - report.test_results - |> Option.map(test_results => - TestView.test_bar( - ~inject, - ~test_results, - YourTestsValidation, - ) - ), - ), - ), - ]); + [@deriving (show({with_path: false}), sexp, yojson)] + type percentage = float; + [@deriving (show({with_path: false}), sexp, yojson)] + type points = float; + [@deriving (show({with_path: false}), sexp, yojson)] + type score = (points, points); + + let score_of_percent = (percent, max_points) => { + let max_points = float_of_int(max_points); + (percent *. max_points, max_points); }; -}; - -module MutationTestingReport = { - include MutationTestingReport; - open Haz3lcore; - - let summary_message = (~score, ~total, ~found): Node.t => - div( - ~attr=Attr.classes(["test-text"]), - [score_view(score), text(summary_str(~total, ~found))], - ); - - let bar = (~inject, instances) => - div( - ~attr=Attr.classes(["test-bar"]), - List.mapi( - (id, (status, _)) => - div( - ~attr= - Attr.many([ - Attr.classes(["segment", TestStatus.to_string(status)]), - Attr.on_click( - //TODO: wire up test ids - TestView.jump_to_test(~inject, HiddenBugs(id), Id.invalid), - ), - ]), - [], - ), - instances, - ), - ); - - let summary = (~inject, ~report, ~max_points) => { - let total = List.length(report.results); - let found = - List.length( - List.filter(((x: TestStatus.t, _)) => x == Pass, report.results), + + module TestValidationReport = { + type t = { + test_results: option(TestResults.t), + required: int, + provided: int, + }; + + let mk = (eds: eds, test_results: option(TestResults.t)) => { + { + test_results, + required: eds.your_tests.required, + provided: eds.your_tests.provided, + }; + }; + + let percentage = (report: t): percentage => { + switch (report.test_results) { + | None => 0.0 + | Some(test_results) => + let num_tests = float_of_int(test_results.total); + let required = float_of_int(report.required); + let provided = float_of_int(report.provided); + let num_passing = float_of_int(test_results.passing); + + required -. provided <= 0.0 || num_tests <= 0.0 + ? 0.0 + : num_passing + /. num_tests + *. ( + Float.max( + 0., + Float.min(num_tests -. provided, required -. provided), + ) + /. (required -. provided) + ); + }; + }; + + let test_summary_str = (test_results: TestResults.t) => { + TestResults.result_summary_str( + ~n=test_results.total, + ~p=test_results.failing, + ~q=test_results.unfinished, + ~n_str="test", + ~ns_str="tests", + ~p_str="failing", + ~q_str="indeterminate", + ~r_str="valid", ); - let status_class = total == found ? "Pass" : "Fail"; - div( - ~attr= - Attr.classes([ - "cell-item", - "test-summary", - "cell-report", - status_class, - ]), - [ - summary_message( - ~score=score_of_percent(percentage(report), max_points), - ~total, - ~found, - ), - bar(~inject, report.results), - ], - ); + }; }; - let individual_report = (id, ~inject, ~hint: string, ~status: TestStatus.t) => - div( - ~attr= - Attr.many([ - Attr.classes(["test-report"]), - //TODO: wire up test ids - Attr.on_click( - TestView.jump_to_test(~inject, HiddenBugs(id), Id.invalid), - ), - ]), - [ - div( - ~attr= - Attr.classes([ - "test-id", - "Test" ++ TestStatus.to_string(status), - ]), - /* NOTE: prints lexical index, not unique id */ - [text(string_of_int(id + 1))], - ), - // TestView.test_instance_view(~font_metrics, instance), - ] - @ [ - div( - ~attr= - Attr.classes([ - "test-hint", - "test-instance", - TestStatus.to_string(status), - ]), - [text(hint)], - ), - ], - ); - - let individual_reports = (~inject, coverage_results) => - div( - coverage_results - |> List.mapi((i, (status, hint)) => - individual_report(i, ~inject, ~hint, ~status) - ), - ); - - // let passing_test_ids = test_map => - // test_map - // |> List.filter(((_id, reports)) => - // List.for_all( - // ((_, status)) => status == Haz3lcore.TestStatus.Pass, - // reports, - // ) - // ) - // |> List.split - // |> fst; - - // let failing_test_ids = test_map => - // test_map - // |> List.filter(((_id, reports)) => - // List.for_all( - // ((_, status)) => status == Haz3lcore.TestStatus.Fail, - // reports, - // ) - // ) - // |> List.split - // |> fst; - - // let get_test_map = (editors: list(Haz3lcore.Editor.t)) => { - // let (reference_term, reference_map) = spliced_statics(editors); - // let result_reference = - // Interface.test_results(reference_map, reference_term); - // switch (result_reference) { - // | None => [] - // | Some(test_results) => test_results.test_map - // }; - // }; - // let show_term = (editor: Editor.t, _) => - // editor.state.zipper - // |> Zipper.zip - // |> MakeTerm.go - // |> fst - // |> Term.UExp.show - // |> print_endline - // |> (_ => Virtual_dom.Vdom.Effect.Ignore); - - // let get_first_common = - // (reference_passing, wrong): (TestStatus.t, option('a)) => { - // let wrong_test_map = wrong |> get_test_map; - // let wrong_failing = wrong_test_map |> failing_test_ids; - // let common = - // List.filter(x => List.mem(x, reference_passing), wrong_failing); - // let instance: option(list('a)) = - // switch (common) { - // | [] => None - // | [x, ..._] => List.assoc_opt(x, wrong_test_map) - // }; - // switch (instance) { - // | Some([instance, ..._]) => (TestStatus.Pass, Some(instance)) - // | _ => (TestStatus.Fail, None) - // }; - // }; - - let view = (~inject, report: t, max_points: int) => - if (max_points == 0) { - Node.div([]); - } else { - Cell.panel( - ~classes=["test-panel"], - [ - Cell.caption( - "Mutation Testing", - ~rest=": Your Tests vs. Buggy Implementations (hidden)", - ), - individual_reports(~inject, report.results), - ], - ~footer=Some(summary(~inject, ~report, ~max_points)), + module MutationTestingReport = { + type t = {results: list((TestStatus.t, string))}; + + let hidden_bug_status = + ( + test_validation_data: DynamicsItem.t, + hidden_bug_data: DynamicsItem.t, + ) + : TestStatus.t => { + switch ( + ModelResult.test_results(test_validation_data.result), + ModelResult.test_results(hidden_bug_data.result), + ) { + | (None, _) + | (_, None) => Indet + | (Some(test_validation_data), Some(hidden_bug_data)) => + let validation_test_map = test_validation_data.test_map; + let hidden_bug_test_map = hidden_bug_data.test_map; + + let found = + hidden_bug_test_map + |> List.find_opt(((id, instance_reports)) => { + let status = TestMap.joint_status(instance_reports); + switch (status) { + | TestStatus.Pass + | TestStatus.Indet => false + | TestStatus.Fail => + let validation_test_reports = + validation_test_map |> TestMap.lookup(id); + switch (validation_test_reports) { + | None => false + | Some(reports) => + let status = TestMap.joint_status(reports); + switch (status) { + | TestStatus.Pass => true + | TestStatus.Fail + | TestStatus.Indet => false + }; + }; + }; + }); + switch (found) { + | None => Fail + | Some(_) => Pass + }; + }; + }; // for each hidden bug + // in the test results data, find a test ID that passes test validation but fails against + + let mk = + ( + ~test_validation: DynamicsItem.t, + ~hidden_bugs_state: list(wrong_impl(Editor.t)), + ~hidden_bugs: list(DynamicsItem.t), + ) + : t => { + let results = + List.map(hidden_bug_status(test_validation), hidden_bugs); + let hints = + List.map( + (wrong_impl: wrong_impl(Editor.t)) => wrong_impl.hint, + hidden_bugs_state, + ); + let results = List.combine(results, hints); + {results: results}; + }; + + let percentage = (report: t): percentage => { + let results = report.results; + let num_wrong_impls = List.length(results); + let num_passed = + results + |> List.find_all(((status, _)) => status == TestStatus.Pass) + |> List.length; + switch (num_wrong_impls) { + | 0 => 1.0 + | _ => float_of_int(num_passed) /. float_of_int(num_wrong_impls) + }; + }; + + // TODO move to separate module + + let summary_str = (~total, ~found): string => { + TestResults.result_summary_str( + ~n=total, + ~p=found, + ~q=0, + ~n_str="bug", + ~ns_str="bugs", + ~p_str="exposed", + ~q_str="", + ~r_str="unrevealed", ); }; -}; - -module SyntaxReport = { - include SyntaxReport; - let individual_report = (i: int, hint: string, status: bool) => { - let result_string = status ? "Pass" : "Indet"; - - div( - ~attr=Attr.classes(["test-report"]), - [ - div( - ~attr=Attr.classes(["test-id", "Test" ++ result_string]), - [text(string_of_int(i + 1))], - ), - ] - @ [ - div( - ~attr=Attr.classes(["test-hint", "test-instance", result_string]), - [text(hint)], - ), - ], - ); }; - let individual_reports = (hinted_results: list((bool, string))) => { - div( - hinted_results - |> List.mapi((i, (status, hint)) => - individual_report(i, hint, status) - ), - ); - }; + module SyntaxReport = { + type t = { + hinted_results: list((bool, hint)), + percentage, + }; - let view = (syntax_report: t) => { - Cell.panel( - ~classes=["test-panel"], - [ - Cell.caption( - "Syntax Validation", - ~rest= - ": Does your implementation satisfy the syntactic requirements?", - ), - individual_reports(syntax_report.hinted_results), - ], - ~footer= - Some( - Cell.report_footer_view([ - div( - ~attr=Attr.classes(["test-summary"]), - [ - div( - ~attr=Attr.class_("test-text"), - [ - percentage_view(syntax_report.percentage), - text( - " of the Implementation Validation points will be earned", - ), - ], - ), - ], - ), - ]), - ), - ); - }; -}; - -module ImplGradingReport = { - open Haz3lcore; - include ImplGradingReport; - let textual_summary = (report: t) => { - switch (report.test_results) { - | None => [Node.text("No test results")] - | Some(test_results) => [ - { - text(test_summary_str(test_results)); - }, - ] + let mk = (~your_impl: Editor.t, ~tests: syntax_tests): t => { + let user_impl_term = your_impl.state.meta.view_term; + + let predicates = + List.map(((_, p)) => SyntaxTest.predicate_fn(p), tests); + let hints = List.map(((h, _)) => h, tests); + let syntax_results = SyntaxTest.check(user_impl_term, predicates); + + { + hinted_results: + List.map2((r, h) => (r, h), syntax_results.results, hints), + percentage: syntax_results.percentage, + }; }; }; - // let summary = (~inject, ~report, ~max_points) => { - // let percentage = percentage(report); - // let score = score_of_percent(percentage); - // let total = total(report); - // let num_passed = num_passed(report); - // let status_class = total == num_passed ? "Pass" : "Fail"; - // div( - // ~attr= - // Attr.classes([ - // "cell-item", - // "test-summary", - // "cell-report", - // status_class, - // ]), - // [ - // summary_message( - // ~score, - // ~total, - // ~found=num_passed, - // ), - // bar(~inject, report.results), - // ], - // ); - // }; - - let individual_report = (i, ~inject, ~hint: string, ~status, (id, _)) => - div( - ~attr= - Attr.many([ - Attr.classes(["test-report"]), - Attr.on_click(TestView.jump_to_test(~inject, HiddenTests, id)), - ]), - [ - div( - ~attr= - Attr.classes([ - "test-id", - "Test" ++ TestStatus.to_string(status), - ]), - /* NOTE: prints lexical index, not unique id */ - [text(string_of_int(i + 1))], - ), - // TestView.test_instance_view(~font_metrics, instance), - ] - @ [ - div( - ~attr= - Attr.classes([ - "test-hint", - "test-instance", - TestStatus.to_string(status), - ]), - [text(hint)], - ), - ], - ); - - let individual_reports = (~inject, ~report) => { - switch (report.test_results) { - | Some(test_results) - when - List.length(test_results.test_map) - == List.length(report.hinted_results) => - /* NOTE: This condition will be false when evaluation crashes, - * for example due to a stack overflow, which may occur in normal operation */ - div( - report.hinted_results - |> List.mapi((i, (status, hint)) => - individual_report( - i, - ~inject, - ~hint, - ~status, - List.nth(test_results.test_map, i), - ) - ), - ) - | _ => div([]) + module ImplGradingReport = { + type t = { + hints: list(string), + test_results: option(TestResults.t), + hinted_results: list((TestStatus.t, string)), + }; + + let mk = (~hints: list(string), ~test_results: option(TestResults.t)): t => { + let hinted_results = + switch (test_results) { + | Some(test_results) => + let statuses = test_results.statuses; + Util.ListUtil.zip_defaults( + statuses, + hints, + Haz3lcore.TestStatus.Indet, + "No hint available.", + ); + + | None => + Util.ListUtil.zip_defaults( + [], + hints, + Haz3lcore.TestStatus.Indet, + "Exercise configuration error: Hint without a test.", + ) + }; + {hints, test_results, hinted_results}; + }; + + let total = (report: t) => List.length(report.hinted_results); + let num_passed = (report: t) => { + report.hinted_results + |> List.find_all(((status, _)) => status == TestStatus.Pass) + |> List.length; + }; + + let percentage = (report: t, syntax_report: SyntaxReport.t): percentage => { + syntax_report.percentage + *. (float_of_int(num_passed(report)) /. float_of_int(total(report))); + }; + + let test_summary_str = (test_results: TestResults.t) => { + TestResults.result_summary_str( + ~n=test_results.total, + ~p=test_results.failing, + ~q=test_results.unfinished, + ~n_str="test", + ~ns_str="tests", + ~p_str="failing", + ~q_str="indeterminate", + ~r_str="valid", + ); }; }; - let view = - (~inject, ~report: t, ~syntax_report: SyntaxReport.t, ~max_points: int) => { - Cell.panel( - ~classes=["cell-item", "panel", "test-panel"], - [ - Cell.caption( - "Implementation Grading", - ~rest=": Hidden Tests vs. Your Implementation", + module GradingReport = { + type t = { + point_distribution, + test_validation_report: TestValidationReport.t, + mutation_testing_report: MutationTestingReport.t, + syntax_report: SyntaxReport.t, + impl_grading_report: ImplGradingReport.t, + }; + + let mk = (eds: eds, ~stitched_dynamics: stitched(DynamicsItem.t)) => { + point_distribution: eds.point_distribution, + test_validation_report: + TestValidationReport.mk( + eds, + ModelResult.test_results(stitched_dynamics.test_validation.result), ), - individual_reports(~inject, ~report), - ], - ~footer= - Some( - Cell.report_footer_view([ - div( - ~attr=Attr.classes(["test-summary"]), - [ - div( - ~attr=Attr.class_("test-text"), - [ - score_view( - score_of_percent( - percentage(report, syntax_report), - max_points, - ), - ), - ] - @ textual_summary(report), - ), - ] - @ Option.to_list( - report.test_results - |> Option.map(test_results => - TestView.test_bar(~inject, ~test_results, HiddenTests) - ), - ), - ), - ]), + mutation_testing_report: + MutationTestingReport.mk( + ~test_validation=stitched_dynamics.test_validation, + ~hidden_bugs_state=eds.hidden_bugs, + ~hidden_bugs=stitched_dynamics.hidden_bugs, ), - ); + syntax_report: + SyntaxReport.mk(~your_impl=eds.your_impl, ~tests=eds.syntax_tests), + impl_grading_report: + ImplGradingReport.mk( + ~hints=eds.hidden_tests.hints, + ~test_results= + ModelResult.test_results(stitched_dynamics.hidden_tests.result), + ), + }; + + let overall_score = + ( + { + point_distribution, + test_validation_report, + mutation_testing_report, + syntax_report, + impl_grading_report, + _, + }: t, + ) + : score => { + let (tv_points, tv_max) = + score_of_percent( + TestValidationReport.percentage(test_validation_report), + point_distribution.test_validation, + ); + let (mt_points, mt_max) = + score_of_percent( + MutationTestingReport.percentage(mutation_testing_report), + point_distribution.mutation_testing, + ); + let (ig_points, ig_max) = + score_of_percent( + ImplGradingReport.percentage(impl_grading_report, syntax_report), + point_distribution.impl_grading, + ); + let total_points = tv_points +. mt_points +. ig_points; + let max_points = tv_max +. mt_max +. ig_max; + (total_points, max_points); + }; }; -}; +} /* }*/; -module GradingReport = { - include GradingReport; +// NEW MODULE FOR DOCUMENTATION MODE / TUTORIAL SYSTEM - let view_overall_score = (report: t) => { - score_view(overall_score(report)); - }; -}; +// module D = (DocEnv: DocumentationEnv.DocEnv) => { +// open DocumentationEnv.D(DocEnv); + +// [@deriving (show({with_path: false}), sexp, yojson)] +// type percentage = float; +// [@deriving (show({with_path: false}), sexp, yojson)] +// type points = float; +// [@deriving (show({with_path: false}), sexp, yojson)] +// type score = (points, points); + +// let score_of_percent = (percent, max_points) => { +// let max_points = float_of_int(max_points); +// (percent *. max_points, max_points); +// }; + +// module TestValidationReport = { +// type t = { +// test_results: option(TestResults.t), +// required: int, +// provided: int, +// }; + +// let mk = (eds: eds, test_results: option(TestResults.t)) => { +// { +// test_results, +// required: eds.your_tests.required, +// provided: eds.your_tests.provided, +// }; +// }; + +// let percentage = (report: t): percentage => { +// switch (report.test_results) { +// | None => 0.0 +// | Some(test_results) => +// let num_tests = float_of_int(test_results.total); +// let required = float_of_int(report.required); +// let provided = float_of_int(report.provided); +// let num_passing = float_of_int(test_results.passing); + +// required -. provided <= 0.0 || num_tests <= 0.0 +// ? 0.0 +// : num_passing +// /. num_tests +// *. ( +// Float.max( +// 0., +// Float.min(num_tests -. provided, required -. provided), +// ) +// /. (required -. provided) +// ); +// }; +// }; + +// let test_summary_str = (test_results: TestResults.t) => { +// TestResults.result_summary_str( +// ~n=test_results.total, +// ~p=test_results.failing, +// ~q=test_results.unfinished, +// ~n_str="test", +// ~ns_str="tests", +// ~p_str="failing", +// ~q_str="indeterminate", +// ~r_str="valid", +// ); +// }; +// }; + +// module MutationTestingReport = { +// type t = {results: list((TestStatus.t, string))}; + +// let hidden_bug_status = +// ( +// test_validation_data: DynamicsItem.t, +// hidden_bug_data: DynamicsItem.t, +// ) +// : TestStatus.t => { +// switch ( +// ModelResult.test_results(test_validation_data.result), +// ModelResult.test_results(hidden_bug_data.result), +// ) { +// | (None, _) +// | (_, None) => Indet +// | (Some(test_validation_data), Some(hidden_bug_data)) => +// let validation_test_map = test_validation_data.test_map; +// let hidden_bug_test_map = hidden_bug_data.test_map; + +// let found = +// hidden_bug_test_map +// |> List.find_opt(((id, instance_reports)) => { +// let status = TestMap.joint_status(instance_reports); +// switch (status) { +// | TestStatus.Pass +// | TestStatus.Indet => false +// | TestStatus.Fail => +// let validation_test_reports = +// validation_test_map |> TestMap.lookup(id); +// switch (validation_test_reports) { +// | None => false +// | Some(reports) => +// let status = TestMap.joint_status(reports); +// switch (status) { +// | TestStatus.Pass => true +// | TestStatus.Fail +// | TestStatus.Indet => false +// }; +// }; +// }; +// }); +// switch (found) { +// | None => Fail +// | Some(_) => Pass +// }; +// }; +// }; // for each hidden bug +// // in the test results data, find a test ID that passes test validation but fails against + +// let mk = +// ( +// ~test_validation: DynamicsItem.t, +// ~hidden_bugs_state: list(wrong_impl(Editor.t)), +// ~hidden_bugs: list(DynamicsItem.t), +// ) +// : t => { +// let results = +// List.map(hidden_bug_status(test_validation), hidden_bugs); +// let hints = +// List.map( +// (wrong_impl: wrong_impl(Editor.t)) => wrong_impl.hint, +// hidden_bugs_state, +// ); +// let results = List.combine(results, hints); +// {results: results}; +// }; + +// let percentage = (report: t): percentage => { +// let results = report.results; +// let num_wrong_impls = List.length(results); +// let num_passed = +// results +// |> List.find_all(((status, _)) => status == TestStatus.Pass) +// |> List.length; +// switch (num_wrong_impls) { +// | 0 => 1.0 +// | _ => float_of_int(num_passed) /. float_of_int(num_wrong_impls) +// }; +// }; + +// // TODO move to separate module + +// let summary_str = (~total, ~found): string => { +// TestResults.result_summary_str( +// ~n=total, +// ~p=found, +// ~q=0, +// ~n_str="bug", +// ~ns_str="bugs", +// ~p_str="exposed", +// ~q_str="", +// ~r_str="unrevealed", +// ); +// }; +// }; + +// module SyntaxReport = { +// type t = { +// hinted_results: list((bool, hint)), +// percentage, +// }; + +// let mk = (~your_impl: Editor.t, ~tests: syntax_tests): t => { +// let user_impl_term = your_impl.state.meta.view_term; + +// let predicates = +// List.map(((_, p)) => SyntaxTest.predicate_fn(p), tests); +// let hints = List.map(((h, _)) => h, tests); +// let syntax_results = SyntaxTest.check(user_impl_term, predicates); + +// { +// hinted_results: +// List.map2((r, h) => (r, h), syntax_results.results, hints), +// percentage: syntax_results.percentage, +// }; +// }; +// }; + +// module ImplGradingReport = { +// type t = { +// hints: list(string), +// test_results: option(TestResults.t), +// hinted_results: list((TestStatus.t, string)), +// }; + +// let mk = (~hints: list(string), ~test_results: option(TestResults.t)): t => { +// let hinted_results = +// switch (test_results) { +// | Some(test_results) => +// let statuses = test_results.statuses; +// Util.ListUtil.zip_defaults( +// statuses, +// hints, +// Haz3lcore.TestStatus.Indet, +// "No hint available.", +// ); + +// | None => +// Util.ListUtil.zip_defaults( +// [], +// hints, +// Haz3lcore.TestStatus.Indet, +// "Exercise configuration error: Hint without a test.", +// ) +// }; +// {hints, test_results, hinted_results}; +// }; + +// let total = (report: t) => List.length(report.hinted_results); +// let num_passed = (report: t) => { +// report.hinted_results +// |> List.find_all(((status, _)) => status == TestStatus.Pass) +// |> List.length; +// }; + +// let percentage = (report: t, syntax_report: SyntaxReport.t): percentage => { +// syntax_report.percentage +// *. (float_of_int(num_passed(report)) /. float_of_int(total(report))); +// }; + +// let test_summary_str = (test_results: TestResults.t) => { +// TestResults.result_summary_str( +// ~n=test_results.total, +// ~p=test_results.failing, +// ~q=test_results.unfinished, +// ~n_str="test", +// ~ns_str="tests", +// ~p_str="failing", +// ~q_str="indeterminate", +// ~r_str="valid", +// ); +// }; +// }; + +// module GradingReport = { +// type t = { +// point_distribution, +// test_validation_report: TestValidationReport.t, +// mutation_testing_report: MutationTestingReport.t, +// syntax_report: SyntaxReport.t, +// impl_grading_report: ImplGradingReport.t, +// }; + +// let mk = (eds: eds, ~stitched_dynamics: stitched(DynamicsItem.t)) => { +// point_distribution: eds.point_distribution, +// test_validation_report: +// TestValidationReport.mk( +// eds, +// ModelResult.test_results(stitched_dynamics.test_validation.result), +// ), +// mutation_testing_report: +// MutationTestingReport.mk( +// ~test_validation=stitched_dynamics.test_validation, +// ~hidden_bugs_state=eds.hidden_bugs, +// ~hidden_bugs=stitched_dynamics.hidden_bugs, +// ), +// syntax_report: +// SyntaxReport.mk(~your_impl=eds.your_impl, ~tests=eds.syntax_tests), +// impl_grading_report: +// ImplGradingReport.mk( +// ~hints=eds.hidden_tests.hints, +// ~test_results= +// ModelResult.test_results(stitched_dynamics.hidden_tests.result), +// ), +// }; + +// let overall_score = +// ( +// { +// point_distribution, +// test_validation_report, +// mutation_testing_report, +// syntax_report, +// impl_grading_report, +// _, +// }: t, +// ) +// : score => { +// let (tv_points, tv_max) = +// score_of_percent( +// TestValidationReport.percentage(test_validation_report), +// point_distribution.test_validation, +// ); +// let (mt_points, mt_max) = +// score_of_percent( +// MutationTestingReport.percentage(mutation_testing_report), +// point_distribution.mutation_testing, +// ); +// let (ig_points, ig_max) = +// score_of_percent( +// ImplGradingReport.percentage(impl_grading_report, syntax_report), +// point_distribution.impl_grading, +// ); +// let total_points = tv_points +. mt_points +. ig_points; +// let max_points = tv_max +. mt_max +. ig_max; +// (total_points, max_points); +// }; +// }; diff --git a/src/haz3lweb/UpdateAction.re b/src/haz3lweb/UpdateAction.re index 17856fff80..98a83c0c8f 100644 --- a/src/haz3lweb/UpdateAction.re +++ b/src/haz3lweb/UpdateAction.re @@ -1,6 +1,7 @@ open Sexplib.Std; open Util; open Haz3lcore; +open Virtual_dom.Vdom; [@deriving (show({with_path: false}), sexp, yojson)] type evaluation_settings_action = @@ -69,6 +70,7 @@ type t = | InitImportAll([@opaque] Js_of_ocaml.Js.t(Js_of_ocaml.File.file)) | FinishImportAll(option(string)) | SwitchEditor(Exercise.pos) //exercisemode only + // | SwitchEditorDoc(DocumentationEnv.pos) | SwitchDocumentationSlide(string) //examplemode only // editors: scratchmode only | InitImportScratchpad([@opaque] Js_of_ocaml.Js.t(Js_of_ocaml.File.file)) diff --git a/src/haz3lweb/view/DocumentationMode.re b/src/haz3lweb/view/DocumentationMode.re index dca740aeec..69db791159 100644 --- a/src/haz3lweb/view/DocumentationMode.re +++ b/src/haz3lweb/view/DocumentationMode.re @@ -9,341 +9,344 @@ open DocumentationEnv; module D = (DocEnv: DocumentationEnv.DocEnv) => { open DocumentationEnv.D(DocEnv); -type vis_marked('a) = - | InstructorOnly(unit => 'a) - | Always('a); -let render_cells = (settings: Settings.t, v: list(vis_marked(Node.t))) => { - List.filter_map( - vis => - switch (vis) { - | InstructorOnly(f) => settings.instructor_mode ? Some(f()) : None - | Always(node) => Some(node) - }, - v, - ); -}; -let view = - ( - ~inject, - ~ui_state: Model.ui_state, - ~settings: Settings.t, - ~documentation: state, - ~results, - ~highlights, - ) => { - let DocumentationEnv.{eds, pos} = documentation; - let stitched_dynamics = - stitch_dynamic( - settings.core, - documentation, - settings.core.dynamics ? Some(results) : None, + type vis_marked('a) = + | InstructorOnly(unit => 'a) + | Always('a); + let render_cells = (settings: Settings.t, v: list(vis_marked(Node.t))) => { + List.filter_map( + vis => + switch (vis) { + | InstructorOnly(f) => settings.instructor_mode ? Some(f()) : None + | Always(node) => Some(node) + }, + v, ); - let { - // test_validation, - user_impl, - // user_tests, - // prelude, - // instructor, - // hidden_bugs, - hidden_tests: _, - }: - stitched(DynamicsItem.t) = stitched_dynamics; - // how does this impact the UI of Exercise mode? - let grading_report = Grading.GradingReport.mk(eds, ~stitched_dynamics); - let score_view = Grading.GradingReport.view_overall_score(grading_report); - let editor_view = + }; + let view = ( - ~editor: Editor.t, - ~caption: string, - ~subcaption: option(string)=?, - ~footer=?, - ~di: Exercise.DynamicsItem.t, - this_pos, + ~inject, + ~ui_state: Model.ui_state, + ~settings: Settings.t, + ~documentation: state, + ~results, + ~highlights, ) => { - Cell.editor_view( - ~selected=pos == this_pos, - ~error_ids= - Statics.Map.error_ids(editor.state.meta.term_ranges, di.info_map), - ~inject, - ~ui_state, - ~mousedown_updates=[SwitchEditor(this_pos)], - ~settings, - ~highlights, - ~caption=Cell.caption(caption, ~rest=?subcaption), - ~target_id=Exercise.show_pos(this_pos), - ~test_results=ModelResult.test_results(di.result), - ~footer?, - editor, - ); - }; - let title_view = Cell.title_cell(eds.title); - let prompt_view = - Cell.narrative_cell( - div(~attr=Attr.class_("cell-prompt"), [eds.prompt]), - ); - let prelude_view = - Always( - editor_view( - Prelude, - ~caption="Prelude", - ~subcaption=settings.instructor_mode ? "" : " (Read-Only)", - ~editor=eds.prelude, - ~di=prelude, - ), - ); - let correct_impl_view = - InstructorOnly( - () => + let DocumentationEnv.{eds, pos} = documentation; + let stitched_dynamics = + stitch_dynamic( + settings.core, + documentation, + settings.core.dynamics ? Some(results) : None, + ); + let { + // test_validation, + user_impl, + // user_tests, + // prelude, + // instructor, + // hidden_bugs, + hidden_tests: _, + }: + stitched(DynamicsItem.t) = stitched_dynamics; + // how does this impact the UI of Exercise mode? + let grading_report = Grading.GradingReport.mk(eds, ~stitched_dynamics); + let score_view = Grading.GradingReport.view_overall_score(grading_report); + let editor_view = + ( + ~editor: Editor.t, + ~caption: string, + ~subcaption: option(string)=?, + ~footer=?, + ~di: Exercise.DynamicsItem.t, + this_pos, + ) => { + Cell.editor_view( + ~selected=pos == this_pos, + ~error_ids= + Statics.Map.error_ids(editor.state.meta.term_ranges, di.info_map), + ~inject, + ~ui_state, + ~mousedown_updates=[SwitchEditor(this_pos)], + ~settings, + ~highlights, + ~caption=Cell.caption(caption, ~rest=?subcaption), + ~target_id=Exercise.show_pos(this_pos), + ~test_results=ModelResult.test_results(di.result), + ~footer?, + editor, + ); + }; + let title_view = Cell.title_cell(eds.title); + let prompt_view = + Cell.narrative_cell( + div(~attr=Attr.class_("cell-prompt"), [eds.prompt]), + ); + let prelude_view = + Always( editor_view( - CorrectImpl, - ~caption="Correct Implementation", - ~editor=eds.correct_impl, - ~di=instructor, + Prelude, + ~caption="Prelude", + ~subcaption=settings.instructor_mode ? "" : " (Read-Only)", + ~editor=eds.prelude, + ~di=prelude, ), - ); - // determine trailing hole - // TODO: module - let correct_impl_ctx_view = - Always( - { - let exp_ctx_view = { - let correct_impl_trailing_hole_ctx = - Haz3lcore.Editor.trailing_hole_ctx( - eds.correct_impl, - instructor.info_map, - ); - let prelude_trailing_hole_ctx = - Haz3lcore.Editor.trailing_hole_ctx(eds.prelude, prelude.info_map); - switch (correct_impl_trailing_hole_ctx, prelude_trailing_hole_ctx) { - | (None, _) => Node.div([text("No context available (1)")]) - | (_, None) => Node.div([text("No context available (2)")]) // TODO show exercise configuration error - | ( - Some(correct_impl_trailing_hole_ctx), - Some(prelude_trailing_hole_ctx), - ) => - let specific_ctx = - Haz3lcore.Ctx.subtract_prefix( - correct_impl_trailing_hole_ctx, - prelude_trailing_hole_ctx, + ); + let correct_impl_view = + InstructorOnly( + () => + editor_view( + CorrectImpl, + ~caption="Correct Implementation", + ~editor=eds.correct_impl, + ~di=instructor, + ), + ); + // determine trailing hole + // TODO: module + let correct_impl_ctx_view = + Always( + { + let exp_ctx_view = { + let correct_impl_trailing_hole_ctx = + Haz3lcore.Editor.trailing_hole_ctx( + eds.correct_impl, + instructor.info_map, + ); + let prelude_trailing_hole_ctx = + Haz3lcore.Editor.trailing_hole_ctx( + eds.prelude, + prelude.info_map, ); - switch (specific_ctx) { - | None => Node.div([text("No context available")]) // TODO show exercise configuration error - | Some(specific_ctx) => - CtxInspector.ctx_view(~inject, specific_ctx) + switch (correct_impl_trailing_hole_ctx, prelude_trailing_hole_ctx) { + | (None, _) => Node.div([text("No context available (1)")]) + | (_, None) => Node.div([text("No context available (2)")]) // TODO show exercise configuration error + | ( + Some(correct_impl_trailing_hole_ctx), + Some(prelude_trailing_hole_ctx), + ) => + let specific_ctx = + Haz3lcore.Ctx.subtract_prefix( + correct_impl_trailing_hole_ctx, + prelude_trailing_hole_ctx, + ); + switch (specific_ctx) { + | None => Node.div([text("No context available")]) // TODO show exercise configuration error + | Some(specific_ctx) => + CtxInspector.ctx_view(~inject, specific_ctx) + }; }; }; - }; - Cell.simple_cell_view([ - Cell.simple_cell_item([ - Cell.caption( - "Correct Implementation", - ~rest=" (Type Signatures Only)", + Cell.simple_cell_view([ + Cell.simple_cell_item([ + Cell.caption( + "Correct Implementation", + ~rest=" (Type Signatures Only)", + ), + exp_ctx_view, + ]), + ]); + }, + ); + let your_tests_view = + Always( + editor_view( + YourTestsValidation, + ~caption="Test Validation", + ~subcaption=": Your Tests vs. Correct Implementation", + ~editor=eds.your_tests.tests, + ~di=test_validation, + ~footer=[ + Grading.TestValidationReport.view( + ~inject, + grading_report.test_validation_report, + grading_report.point_distribution.test_validation, ), - exp_ctx_view, - ]), - ]); - }, - ); - let your_tests_view = - Always( - editor_view( - YourTestsValidation, - ~caption="Test Validation", - ~subcaption=": Your Tests vs. Correct Implementation", - ~editor=eds.your_tests.tests, - ~di=test_validation, - ~footer=[ - Grading.TestValidationReport.view( - ~inject, - grading_report.test_validation_report, - grading_report.point_distribution.test_validation, + ], + ), + ); + let wrong_impl_views = + List.mapi( + (i, (Exercise.{impl, _}, di)) => { + InstructorOnly( + () => + editor_view( + HiddenBugs(i), + ~caption="Wrong Implementation " ++ string_of_int(i + 1), + ~editor=impl, + ~di, + ), + ) + }, + List.combine(eds.hidden_bugs, hidden_bugs), + ); + let mutation_testing_view = + Always( + Grading.MutationTestingReport.view( + ~inject, + grading_report.mutation_testing_report, + grading_report.point_distribution.mutation_testing, + ), + ); + let your_impl_view = { + Always( + editor_view( + YourImpl, + ~caption="Your Implementation", + ~editor=eds.your_impl, + ~di=user_impl, + ~footer= + Cell.footer( + ~locked=false, + ~settings, + ~inject, + ~ui_state, + ~result=user_impl.result, + ~result_key=Exercise.user_impl_key, + ), + ), + ); + }; + let syntax_grading_view = + Always(Grading.SyntaxReport.view(grading_report.syntax_report)); + let impl_validation_view = + Always( + editor_view( + YourTestsTesting, + ~caption="Implementation Validation", + ~subcaption= + ": Your Tests (code synchronized with Test Validation cell above) vs. Your Implementation", + ~editor=eds.your_tests.tests, + ~di=user_tests, + ~footer=[ + Cell.test_report_footer_view( + ~inject, + ~test_results=ModelResult.test_results(user_tests.result), + ), + ], + ), + ); + let hidden_tests_view = + InstructorOnly( + () => + editor_view( + HiddenTests, + ~caption="Hidden Tests", + ~editor=eds.hidden_tests.tests, + ~di=instructor, ), + ); + let impl_grading_view = + Always( + Grading.ImplGradingReport.view( + ~inject, + ~report=grading_report.impl_grading_report, + ~syntax_report=grading_report.syntax_report, + ~max_points=grading_report.point_distribution.impl_grading, + ), + ); + [score_view, title_view, prompt_view] + @ render_cells( + settings, + [ + prelude_view, + correct_impl_view, + correct_impl_ctx_view, + your_tests_view, + ] + @ wrong_impl_views + @ [ + mutation_testing_view, + your_impl_view, + syntax_grading_view, + impl_validation_view, + hidden_tests_view, + impl_grading_view, ], - ), - ); - let wrong_impl_views = - List.mapi( - (i, (Exercise.{impl, _}, di)) => { - InstructorOnly( - () => - editor_view( - HiddenBugs(i), - ~caption="Wrong Implementation " ++ string_of_int(i + 1), - ~editor=impl, - ~di, - ), - ) + ); + }; + let reset_button = inject => + Widgets.button_named( + Icons.trash, + _ => { + let confirmed = + JsUtil.confirm( + "Are you SURE you want to reset this exercise? You will lose any existing code that you have written, and course staff have no way to restore it!", + ); + if (confirmed) { + inject(UpdateAction.ResetCurrentEditor); + } else { + Virtual_dom.Vdom.Effect.Ignore; + }; }, - List.combine(eds.hidden_bugs, hidden_bugs), - ); - let mutation_testing_view = - Always( - Grading.MutationTestingReport.view( - ~inject, - grading_report.mutation_testing_report, - grading_report.point_distribution.mutation_testing, - ), + ~tooltip="Reset Exercise", ); - let your_impl_view = { - Always( - editor_view( - YourImpl, - ~caption="Your Implementation", - ~editor=eds.your_impl, - ~di=user_impl, - ~footer= - Cell.footer( - ~locked=false, - ~settings, - ~inject, - ~ui_state, - ~result=user_impl.result, - ~result_key=Exercise.user_impl_key, - ), - ), + let instructor_export = (exercise: Exercise.state) => + Widgets.button_named( + Icons.star, + _ => { + // .ml files because show uses OCaml syntax (dune handles seamlessly) + let module_name = exercise.eds.module_name; + let filename = exercise.eds.module_name ++ ".ml"; + let content_type = "text/plain"; + let contents = Exercise.export_module(module_name, exercise); + JsUtil.download_string_file(~filename, ~content_type, ~contents); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Exercise Module", ); - }; - let syntax_grading_view = - Always(Grading.SyntaxReport.view(grading_report.syntax_report)); - let impl_validation_view = - Always( - editor_view( - YourTestsTesting, - ~caption="Implementation Validation", - ~subcaption= - ": Your Tests (code synchronized with Test Validation cell above) vs. Your Implementation", - ~editor=eds.your_tests.tests, - ~di=user_tests, - ~footer=[ - Cell.test_report_footer_view( - ~inject, - ~test_results=ModelResult.test_results(user_tests.result), - ), - ], - ), + let instructor_transitionary_export = (exercise: Exercise.state) => + Widgets.button_named( + Icons.star, + _ => { + // .ml files because show uses OCaml syntax (dune handles seamlessly) + let module_name = exercise.eds.module_name; + let filename = exercise.eds.module_name ++ ".ml"; + let content_type = "text/plain"; + let contents = + Exercise.export_transitionary_module(module_name, exercise); + JsUtil.download_string_file(~filename, ~content_type, ~contents); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Transitionary Exercise Module", ); - let hidden_tests_view = - InstructorOnly( - () => - editor_view( - HiddenTests, - ~caption="Hidden Tests", - ~editor=eds.hidden_tests.tests, - ~di=instructor, - ), + let instructor_grading_export = (exercise: Exercise.state) => + Widgets.button_named( + Icons.star, + _ => { + // .ml files because show uses OCaml syntax (dune handles seamlessly) + let module_name = exercise.eds.module_name; + let filename = exercise.eds.module_name ++ "_grading.ml"; + let content_type = "text/plain"; + let contents = Exercise.export_grading_module(module_name, exercise); + JsUtil.download_string_file(~filename, ~content_type, ~contents); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Grading Exercise Module", ); - let impl_grading_view = - Always( - Grading.ImplGradingReport.view( - ~inject, - ~report=grading_report.impl_grading_report, - ~syntax_report=grading_report.syntax_report, - ~max_points=grading_report.point_distribution.impl_grading, - ), + let download_editor_state = (~instructor_mode) => + Log.get_and(log => { + let data = Export.export_all(~instructor_mode, ~log); + JsUtil.download_json(ExerciseSettings.filename, data); + }); + let export_submission = (~settings: Settings.t) => + Widgets.button_named( + Icons.star, + _ => { + download_editor_state(~instructor_mode=settings.instructor_mode); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Submission", ); - [score_view, title_view, prompt_view] - @ render_cells( - settings, - [ - prelude_view, - correct_impl_view, - correct_impl_ctx_view, - your_tests_view, - ] - @ wrong_impl_views - @ [ - mutation_testing_view, - your_impl_view, - syntax_grading_view, - impl_validation_view, - hidden_tests_view, - impl_grading_view, - ], + let import_submission = (~inject) => + Widgets.file_select_button_named( + "import-submission", + Icons.star, + file => { + switch (file) { + | None => Virtual_dom.Vdom.Effect.Ignore + | Some(file) => inject(UpdateAction.InitImportAll(file)) + } + }, + ~tooltip="Import Submission", ); }; -let reset_button = inject => - Widgets.button_named( - Icons.trash, - _ => { - let confirmed = - JsUtil.confirm( - "Are you SURE you want to reset this exercise? You will lose any existing code that you have written, and course staff have no way to restore it!", - ); - if (confirmed) { - inject(UpdateAction.ResetCurrentEditor); - } else { - Virtual_dom.Vdom.Effect.Ignore; - }; - }, - ~tooltip="Reset Exercise", - ); -let instructor_export = (exercise: Exercise.state) => - Widgets.button_named( - Icons.star, - _ => { - // .ml files because show uses OCaml syntax (dune handles seamlessly) - let module_name = exercise.eds.module_name; - let filename = exercise.eds.module_name ++ ".ml"; - let content_type = "text/plain"; - let contents = Exercise.export_module(module_name, exercise); - JsUtil.download_string_file(~filename, ~content_type, ~contents); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Exercise Module", - ); -let instructor_transitionary_export = (exercise: Exercise.state) => - Widgets.button_named( - Icons.star, - _ => { - // .ml files because show uses OCaml syntax (dune handles seamlessly) - let module_name = exercise.eds.module_name; - let filename = exercise.eds.module_name ++ ".ml"; - let content_type = "text/plain"; - let contents = - Exercise.export_transitionary_module(module_name, exercise); - JsUtil.download_string_file(~filename, ~content_type, ~contents); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Transitionary Exercise Module", - ); -let instructor_grading_export = (exercise: Exercise.state) => - Widgets.button_named( - Icons.star, - _ => { - // .ml files because show uses OCaml syntax (dune handles seamlessly) - let module_name = exercise.eds.module_name; - let filename = exercise.eds.module_name ++ "_grading.ml"; - let content_type = "text/plain"; - let contents = Exercise.export_grading_module(module_name, exercise); - JsUtil.download_string_file(~filename, ~content_type, ~contents); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Grading Exercise Module", - ); -let download_editor_state = (~instructor_mode) => - Log.get_and(log => { - let data = Export.export_all(~instructor_mode, ~log); - JsUtil.download_json(ExerciseSettings.filename, data); - }); -let export_submission = (~settings: Settings.t) => - Widgets.button_named( - Icons.star, - _ => { - download_editor_state(~instructor_mode=settings.instructor_mode); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Submission", - ); -let import_submission = (~inject) => - Widgets.file_select_button_named( - "import-submission", - Icons.star, - file => { - switch (file) { - | None => Virtual_dom.Vdom.Effect.Ignore - | Some(file) => inject(UpdateAction.InitImportAll(file)) - } - }, - ~tooltip="Import Submission", - ); -}; \ No newline at end of file