diff --git a/src/haz3lschool/DocumentationEnv.re b/src/haz3lschool/DocumentationEnv.re new file mode 100644 index 0000000000..e8ba9fb2a0 --- /dev/null +++ b/src/haz3lschool/DocumentationEnv.re @@ -0,0 +1,969 @@ +open Sexplib.Std; +open Haz3lcore; + +module type DocEnv = { + type node; + let default: node; + let output_header: string => string; +}; + +let output_header_grading = _module_name => + "module Documentation = GradePrelude.Documentation\n" ++ "let prompt = ()\n"; + +module D = (DocEnv: DocEnv) => { + [@deriving (show({with_path: false}), sexp, yojson)] + type wrong_impl('code) = { + impl: 'code, + hint: string, + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + type hidden_tests('code) = { + tests: 'code, + hints: list(string), + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + type hint = string; + + // [@deriving (show({with_path: false}), sexp, yojson)] + // type syntax_test = (hint, SyntaxTest.predicate); + + // [@deriving (show({with_path: false}), sexp, yojson)] + // type syntax_tests = list(syntax_test); + + [@deriving (show({with_path: false}), sexp, yojson)] + type your_tests('code) = { + tests: 'code, + required: int, + provided: int, + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + type point_distribution = { + test_validation: int, + mutation_testing: int, + impl_grading: int, + }; + + let validate_point_distribution = + ({test_validation, mutation_testing, impl_grading}: point_distribution) => + test_validation + mutation_testing + impl_grading == 100 + ? () : failwith("Invalid point distribution in tutorial."); + + [@deriving (show({with_path: false}), sexp, yojson)] + type p('code) = { + title: string, + description: string, + // version: int, + // module_name: string, + // prompt: + // [@printer (fmt, _) => Format.pp_print_string(fmt, "prompt")] [@opaque] ExerciseEnv.node, + // point_distribution, + // prelude: 'code, + // correct_impl: 'code, + // your_tests: your_tests('code), + your_impl: 'code, + // hidden_bugs: list(wrong_impl('code)), + hidden_tests: hidden_tests('code), + // syntax_tests, + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + type key = (string, int); + + let key_of = p => { + p.title; + }; + + let find_key_opt = (key, specs: list(p('code))) => { + specs |> Util.ListUtil.findi_opt(spec => key_of(spec) == key); + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + type pos = + // | Prelude + // | CorrectImpl + // | YourTestsValidation + // | YourTestsTesting + | YourImpl + // | HiddenBugs(int) + | HiddenTests; + + [@deriving (show({with_path: false}), sexp, yojson)] + type spec = p(Zipper.t); + + [@deriving (show({with_path: false}), sexp, yojson)] + type transitionary_spec = p(CodeString.t); + + let map = (p: p('a), f: 'a => 'b): p('b) => { + { + title: p.title, + description: p.description, + // version: p.version, + // module_name: p.module_name, + // prompt: p.prompt, + // point_distribution: p.point_distribution, + // prelude: f(p.prelude), + // correct_impl: f(p.correct_impl), + // your_tests: { + // tests: f(p.your_tests.tests), + // required: p.your_tests.required, + // provided: p.your_tests.provided, + // }, + your_impl: f(p.your_impl), + // hidden_bugs: + // p.hidden_bugs + // |> List.map(wrong_impl => { + // { + // impl: PersistentZipper.persist(wrong_impl.impl), + // hint: wrong_impl.hint, + // } + // }), + hidden_tests: { + tests: PersistentZipper.persist(p.hidden_tests.tests), + hints: p.hidden_tests.hints, + }, + // syntax_tests: p.syntax_tests, + }; + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + type eds = p(Editor.t); + + [@deriving (show({with_path: false}), sexp, yojson)] + type state = { + pos, + eds, + }; + + let key_of_state = ({eds, _}) => key_of(eds); + + [@deriving (show({with_path: false}), sexp, yojson)] + type persistent_state = (pos, list((pos, PersistentZipper.t))); + + let editor_of_state: state => Editor.t = + ({pos, eds, _}) => + switch (pos) { + // | Prelude => eds.prelude + // | CorrectImpl => eds.correct_impl + // | YourTestsValidation => eds.your_tests.tests + // | YourTestsTesting => eds.your_tests.tests + | YourImpl => eds.your_impl + // | HiddenBugs(i) => List.nth(eds.hidden_bugs, i).impl + | HiddenTests => eds.hidden_tests.tests + }; + + let put_editor = ({pos, eds, _} as state: state, editor: Editor.t) => + switch (pos) { + // | Prelude => { + // ...state, + // eds: { + // ...eds, + // prelude: editor, + // }, + // } + // | CorrectImpl => { + // ...state, + // eds: { + // ...eds, + // correct_impl: editor, + // }, + // } + // | YourTestsValidation + // | YourTestsTesting => { + // ...state, + // eds: { + // ...eds, + // your_tests: { + // ...eds.your_tests, + // tests: editor, + // }, + // }, + // } + | YourImpl => { + ...state, + eds: { + ...eds, + your_impl: editor, + }, + } + // | HiddenBugs(n) => { + // ...state, + // eds: { + // ...eds, + // hidden_bugs: + // Util.ListUtil.put_nth( + // n, + // {...List.nth(eds.hidden_bugs, n), impl: editor}, + // eds.hidden_bugs, + // ), + // }, + // } + | HiddenTests => { + ...state, + eds: { + ...eds, + hidden_tests: { + ...eds.hidden_tests, + tests: editor, + }, + }, + } + }; + + let editors = ({eds, _}: state) => + [ + // eds.prelude, + // eds.correct_impl, + // eds.your_tests.tests, + // eds.your_tests.tests, + eds.your_impl, + ] + // @ List.map(wrong_impl => wrong_impl.impl, eds.hidden_bugs) + @ [eds.hidden_tests.tests]; + + let editor_positions = + [YourImpl] + // @ List.mapi((i, _) => HiddenBugs(i), eds.hidden_bugs) + @ [HiddenTests]; + + let positioned_editors = state => + List.combine(editor_positions, editors(state)); + + let idx_of_pos = (pos, p: p('code)) => + switch (pos) { + // | Prelude => 0 + // | CorrectImpl => 1 + // | YourTestsTesting => 2 + // | YourTestsValidation => 3 + | YourImpl => 0 + // | HiddenBugs(i) => + // if (i < List.length(p.hidden_bugs)) { + // 5 + i; + // } else { + // failwith("invalid hidden bug index"); + // } + | HiddenTests => 0 + List.length(p.hidden_tests.tests) // NEED TO FIGURE OUT HOW TO ACTUALLY MAKE THIS WORK + }; + + let pos_of_idx = (p: p('code), idx: int) => + switch (idx) { + // | 0 => Prelude + // | 1 => CorrectImpl + // | 2 => YourTestsTesting + // | 3 => YourTestsValidation + | 0 => YourImpl + | _ => + if (idx < 0) { + failwith( + "negative idx", + // } else if (idx < 5 + List.length(p.hidden_bugs)) { + // HiddenBugs(idx - 5); + ); + } else if (idx == 0 + (+ List.length(p.hidden_tests.tests))) { + HiddenTests; + } else { + failwith("element idx"); + } + }; + + let switch_editor = (~pos, instructor_mode, ~documentation) => + if (!instructor_mode) { + switch (pos) { + | HiddenTests + // | HiddenBugs(_) => exercise + | _ => {eds: documentation.eds, pos} + }; + } else { + {eds: documentation.eds, pos}; + }; + + let zipper_of_code = code => { + switch (Printer.zipper_of_string(code)) { + | None => failwith("Transition failed.") + | Some(zipper) => zipper + }; + }; + + let transition: transitionary_spec => spec = + ( + { + title, + description, + // version, + // module_name, + // prompt, + // point_distribution, + // prelude, + // correct_impl, + // your_tests, + your_impl, + // hidden_bugs, + hidden_tests, + // syntax_tests, + }, + ) => { + // let prelude = zipper_of_code(prelude); + // let correct_impl = zipper_of_code(correct_impl); + // let your_tests = { + // let tests = zipper_of_code(your_tests.tests); + // {tests, required: your_tests.required, provided: your_tests.provided}; + // }; + let your_impl = zipper_of_code(your_impl); + // let hidden_bugs = + // List.fold_left( + // (acc, {impl, hint}) => { + // let impl = zipper_of_code(impl); + // acc @ [{impl, hint}]; + // }, + // [], + // hidden_bugs, + // ); + let hidden_tests = { + let {tests, hints} = hidden_tests; + let tests = zipper_of_code(tests); + {tests, hints}; + }; + { + title, + description, + // version, + // module_name, + // prompt, + // point_distribution, + // prelude, + // correct_impl, + // your_tests, + your_impl, + // hidden_bugs, + hidden_tests, + // syntax_tests, + }; + }; + + let editor_of_serialization = zipper => Editor.init(zipper); + let eds_of_spec: spec => eds = + ( + { + title, + description, + // version, + // module_name, + // prompt, + // point_distribution, + // prelude, + // correct_impl, + // your_tests, + your_impl, + // hidden_bugs, + hidden_tests, + // syntax_tests, + }, + ) => { + // let prelude = editor_of_serialization(prelude); + // let correct_impl = editor_of_serialization(correct_impl); + // let your_tests = { + // let tests = editor_of_serialization(your_tests.tests); + // {tests, required: your_tests.required, provided: your_tests.provided}; + // }; + let your_impl = editor_of_serialization(your_impl); + // let hidden_bugs = + // hidden_bugs + // |> List.map(({impl, hint}) => { + // let impl = editor_of_serialization(impl); + // {impl, hint}; + // }); + let hidden_tests = { + let {tests, hints} = hidden_tests; + let tests = editor_of_serialization(tests); + {tests, hints}; + }; + { + title, + description, + // version, + // module_name, + // prompt, + // point_distribution, + // prelude, + // correct_impl, + // your_tests, + your_impl, + // hidden_bugs, + hidden_tests, + // syntax_tests, + }; + }; + + // FIX ME + + // let set_instructor_mode = ({eds, _} as state: state, new_mode: bool) => { + // ...state, + // eds: { + // ...eds, + // prelude: Editor.set_read_only(eds.prelude, !new_mode), + // }, + // }; + let set_instructor_mode = ({eds, _} as state: state, new_mode: bool) => { + let updated_hidden_tests = { + ...eds.hidden_tests, + tests: Editor.set_read_only(eds.hidden_tests.tests, !new_mode), + }; + + { + ...state, + eds: { + ...eds, + hidden_tests: updated_hidden_tests, + }, + }; + }; + + let visible_in = (pos, ~instructor_mode) => { + switch (pos) { + // | Prelude => instructor_mode + // | CorrectImpl => instructor_mode + // | YourTestsValidation => true + // | YourTestsTesting => false + | YourImpl => true + // | HiddenBugs(_) => instructor_mode + | HiddenTests => instructor_mode + }; + }; + + let state_of_spec = (spec, ~instructor_mode: bool): state => { + let eds = eds_of_spec(spec); + set_instructor_mode({pos: YourImpl, eds}, instructor_mode); + }; + + let persistent_state_of_state = + ({pos, _} as state: state, ~instructor_mode: bool) => { + let zippers = + positioned_editors(state) + |> List.filter(((pos, _)) => visible_in(pos, ~instructor_mode)) + |> List.map(((pos, editor)) => { + (pos, PersistentZipper.persist(Editor.(editor.state.zipper))) + }); + (pos, zippers); + }; + + let unpersist_state = + ( + (pos, positioned_zippers): persistent_state, + ~spec: spec, + ~instructor_mode: bool, + ) + : state => { + let lookup = (pos, default) => + if (visible_in(pos, ~instructor_mode)) { + let persisted_zipper = List.assoc(pos, positioned_zippers); + let zipper = PersistentZipper.unpersist(persisted_zipper); + Editor.init(zipper); + } else { + editor_of_serialization(default); + }; + // let prelude = lookup(Prelude, spec.prelude); + // let correct_impl = lookup(CorrectImpl, spec.correct_impl); + // let your_tests_tests = lookup(YourTestsValidation, spec.your_tests.tests); + let your_impl = lookup(YourImpl, spec.your_impl); + // let (_, hidden_bugs) = + // List.fold_left( + // ((i, hidden_bugs: list(wrong_impl(Editor.t))), {impl, hint}) => { + // let impl = lookup(HiddenBugs(i), impl); + // (i + 1, hidden_bugs @ [{impl, hint}]); + // }, + // (0, []), + // spec.hidden_bugs, + // ); + let hidden_tests_tests = lookup(HiddenTests, spec.hidden_tests.tests); + + set_instructor_mode( + { + pos, + eds: { + title: spec.title, + description: spec.description, + // version: spec.version, + // module_name: spec.module_name, + // prompt: spec.prompt, + // point_distribution: spec.point_distribution, + // prelude, + // correct_impl, + // your_tests: { + // tests: your_tests_tests, + // required: spec.your_tests.required, + // provided: spec.your_tests.provided, + // }, + your_impl, + // hidden_bugs, + hidden_tests: { + tests: hidden_tests_tests, + hints: spec.hidden_tests.hints, + }, + }, + // syntax_tests: spec.syntax_tests, + }, + instructor_mode, + ); + }; + + // # Stitching + + module TermItem = { + type t = { + term: TermBase.UExp.t, + term_ranges: TermRanges.t, + }; + }; + + module StaticsItem = { + type t = CachedStatics.statics; + }; + + type stitched('a) = { + // test_validation: 'a, // prelude + correct_impl + your_tests + user_impl: 'a, // prelude + your_impl + // user_tests: 'a, // prelude + your_impl + your_tests + // prelude: 'a, // prelude + // instructor: 'a, // prelude + correct_impl + hidden_tests.tests // TODO only needs to run in instructor mode + // hidden_bugs: list('a), // prelude + hidden_bugs[i].impl + your_tests, + hidden_tests: 'a, + }; + + let wrap_filter = (act: FilterAction.action, term: Term.UExp.t): Term.UExp.t => + TermBase.UExp.{ + term: + TermBase.UExp.Filter( + FilterAction.(act, One), + {term: Constructor("$e"), ids: [Id.mk()]}, + term, + ), + ids: [Id.mk()], + }; + + let wrap = (term, editor: Editor.t): TermItem.t => { + term, + term_ranges: editor.state.meta.term_ranges, + }; + + let term_of = (editor: Editor.t): Term.UExp.t => + editor.state.meta.view_term; + + let stitch3 = (ed1: Editor.t, ed2: Editor.t, ed3: Editor.t) => + EditorUtil.append_exp( + EditorUtil.append_exp(term_of(ed1), term_of(ed2)), + term_of(ed3), + ); + + let stitch1 = (ed1: Editor.t) => + // EditorUtil.append_exp( + EditorUtil.append_exp(term_of(ed1)); + // term_of(ed3), + // ); + + let stitch_term = ({eds, _}: state): stitched(TermItem.t) => { + // let instructor = + // stitch3(eds.hidden_tests.tests); + let user_impl_term = { + // let your_impl_term = + eds.your_impl |> term_of |> wrap_filter(FilterAction.Step); // let prelude_term = + // EditorUtil.append_exp(your_impl_term); + }; + // let test_validation_term = + // stitch3(eds.prelude, eds.correct_impl, eds.your_tests.tests); + // let user_tests_term = + // EditorUtil.append_exp(user_impl_term, term_of(eds.your_tests.tests)); + let hidden_tests_term = + EditorUtil.append_exp(user_impl_term, term_of(eds.hidden_tests.tests)); + { + // test_validation: wrap(test_validation_term, eds.your_tests.tests), + user_impl: wrap(user_impl_term, eds.your_impl), + // user_tests: wrap(user_tests_term, eds.your_tests.tests), + // instructor works here as long as you don't shadow anything in the prelude + // prelude: wrap(instructor, eds.prelude), + // instructor: wrap(instructor, eds.correct_impl), + // hidden_bugs: + // List.map( + // (t): TermItem.t => + // // term_of(t.impl), + // wrap(stitch3(eds.prelude, t.impl, eds.your_tests.tests), t.impl), + // eds.hidden_bugs, + // ), + hidden_tests: wrap(hidden_tests_term, eds.hidden_tests.tests), + }; + }; + let stitch_term = Core.Memo.general(stitch_term); + + type stitched_statics = stitched(StaticsItem.t); + + /* Multiple stitchings are needed for each exercise + (see comments in the stitched type above) + + Stitching is necessary to concatenate terms + from different editors, which are then typechecked. */ + let stitch_static = + (settings: CoreSettings.t, t: stitched(TermItem.t)): stitched_statics => { + let mk = ({term, term_ranges, _}: TermItem.t): StaticsItem.t => { + let info_map = Interface.Statics.mk_map(settings, term); + { + term, + error_ids: Statics.Map.error_ids(term_ranges, info_map), + info_map, + }; + }; + // let instructor = mk(t.instructor); + { + // test_validation: mk(t.test_validation), + user_impl: mk(t.user_impl), + // user_tests: mk(t.user_tests), + // prelude: instructor, // works as long as you don't shadow anything in the prelude + // instructor, + // hidden_bugs: List.map(mk, t.hidden_bugs), + hidden_tests: mk(t.hidden_tests), + }; + }; + + let stitch_static = Core.Memo.general(stitch_static); + + let statics_of_stiched = + (state: state, s: stitched(StaticsItem.t)): StaticsItem.t => + switch (state.pos) { + // | Prelude => s.prelude + // | CorrectImpl => s.instructor + // | YourTestsValidation => s.test_validation + // | YourTestsTesting => s.user_tests + | YourImpl => s.user_impl + // | HiddenBugs(idx) => List.nth(s.hidden_bugs, idx) + | HiddenTests => s.hidden_tests + }; + + let statics_of = (~settings, documentation: state): StaticsItem.t => + documentation + |> stitch_term + |> stitch_static(settings) + |> statics_of_stiched(documentation); + + let prelude_key = "prelude"; + let test_validation_key = "test_validation"; + let user_impl_key = "user_impl"; + let user_tests_key = "user_tests"; + let instructor_key = "instructor"; + let hidden_bugs_key = n => "hidden_bugs_" ++ string_of_int(n); + let hidden_tests_key = "hidden_tests"; + + let key_for_statics = (state: state): string => + switch (state.pos) { + // | Prelude => prelude_key + // | CorrectImpl => instructor_key + // | YourTestsValidation => test_validation_key + // | YourTestsTesting => user_tests_key + | YourImpl => user_impl_key + // | HiddenBugs(idx) => hidden_bugs_key(idx) + | HiddenTests => hidden_tests_key + }; + + let spliced_elabs = + (settings: CoreSettings.t, state: state) + : list((ModelResults.key, DHExp.t)) => { + let { + // test_validation, + user_impl, + // user_tests, + // prelude: _, + // instructor, + // hidden_bugs, + hidden_tests, + } = + stitch_static(settings, stitch_term(state)); + let elab = (s: CachedStatics.statics) => + Interface.elaborate(~settings, s.info_map, s.term); + [ + // (test_validation_key, elab(test_validation)), + (user_impl_key, elab(user_impl)), + // (user_tests_key, elab(user_tests)), + // (instructor_key, elab(instructor)), + (hidden_tests_key, elab(hidden_tests)), + ]; + // @ ( + // hidden_bugs + // |> List.mapi((n, hidden_bug: StaticsItem.t) => + // (hidden_bugs_key(n), elab(hidden_bug)) + // ) + // ); + }; + + let mk_statics = + (settings: CoreSettings.t, state: state) + : list((ModelResults.key, StaticsItem.t)) => { + let stitched = stitch_static(settings, stitch_term(state)); + [ + // (prelude_key, stitched.prelude), + // (test_validation_key, stitched.test_validation), + (user_impl_key, stitched.user_impl), + // (user_tests_key, stitched.user_tests), + // (instructor_key, stitched.instructor), + (hidden_tests_key, stitched.hidden_tests), + ]; + // @ List.mapi( + // (n, hidden_bug: StaticsItem.t) => (hidden_bugs_key(n), hidden_bug), + // stitched.hidden_bugs, + // ); + }; + + module DynamicsItem = { + type t = { + term: TermBase.UExp.t, + info_map: Statics.Map.t, + result: ModelResult.t, + }; + let empty: t = { + term: { + term: Tuple([]), + ids: [Id.mk()], + }, + info_map: Id.Map.empty, + result: NoElab, + }; + let statics_only = ({term, info_map, _}: StaticsItem.t): t => { + {term, info_map, result: NoElab}; + }; + }; + + /* Given the evaluation results, collects the + relevant information for producing dynamic + feedback*/ + let stitch_dynamic = + ( + settings: CoreSettings.t, + state: state, + results: option(ModelResults.t), + ) + : stitched(DynamicsItem.t) => { + let { + // test_validation, + user_impl, + // user_tests, + // prelude, + // instructor, + // hidden_bugs, + hidden_tests, + } = + stitch_static(settings, stitch_term(state)); + let result_of = key => + switch (results) { + | None => ModelResult.NoElab + | Some(results) => + ModelResults.lookup(results, key) + |> Option.value(~default=ModelResult.NoElab) + }; + + // let test_validation = + // DynamicsItem.{ + // term: test_validation.term, + // info_map: test_validation.info_map, + // result: result_of(test_validation_key), + // }; + + let user_impl = + DynamicsItem.{ + term: user_impl.term, + info_map: user_impl.info_map, + result: result_of(user_impl_key), + }; + + // let user_tests = + // DynamicsItem.{ + // term: user_tests.term, + // info_map: user_tests.info_map, + // result: result_of(user_tests_key), + // }; + // let prelude = + // DynamicsItem.{ + // term: prelude.term, + // info_map: prelude.info_map, + // result: NoElab, + // }; + // let instructor = + // DynamicsItem.{ + // term: instructor.term, + // info_map: instructor.info_map, + // result: result_of(instructor_key), + // }; + // let hidden_bugs = + // List.mapi( + // (n, statics_item: StaticsItem.t) => + // DynamicsItem.{ + // term: statics_item.term, + // info_map: statics_item.info_map, + // result: result_of(hidden_bugs_key(n)), + // }, + // hidden_bugs, + // ); + let hidden_tests = + DynamicsItem.{ + term: hidden_tests.term, + info_map: hidden_tests.info_map, + result: result_of(hidden_tests_key), + }; + { + // test_validation, + user_impl, + // user_tests, + // instructor, + // prelude, + // hidden_bugs, + hidden_tests, + }; + }; + + let stitch_dynamic = + ( + settings: CoreSettings.t, + state: state, + results: option(ModelResults.t), + ) + : stitched(DynamicsItem.t) => + if (settings.statics && settings.dynamics) { + stitch_dynamic(settings, state, results); + } else if (settings.statics) { + let t = stitch_static(settings, stitch_term(state)); + { + // test_validation: DynamicsItem.statics_only(t.test_validation), + user_impl: DynamicsItem.statics_only(t.user_impl), + // user_tests: DynamicsItem.statics_only(t.user_tests), + // instructor: DynamicsItem.statics_only(t.instructor), + // prelude: DynamicsItem.statics_only(t.prelude), + // hidden_bugs: List.map(DynamicsItem.statics_only, t.hidden_bugs), + hidden_tests: DynamicsItem.statics_only(t.hidden_tests), + }; + } else { + { + // test_validation: DynamicsItem.empty, + user_impl: DynamicsItem.empty, + // user_tests: DynamicsItem.empty, + // instructor: DynamicsItem.empty, + // prelude: DynamicsItem.empty, + // hidden_bugs: + // List.init(List.length(state.eds.hidden_bugs), _ => + // DynamicsItem.empty + // ), + hidden_tests: DynamicsItem.empty, + }; + }; + let stitch_dynamic = Core.Memo.general(stitch_dynamic); + + // Module Export + + let editor_pp = (fmt, editor: Editor.t) => { + let zipper = editor.state.zipper; + let serialization = Zipper.show(zipper); + // let string_literal = "\"" ++ String.escaped(serialization) ++ "\""; + Format.pp_print_string(fmt, serialization); + }; + + let export_module = (module_name, {eds, _}: state) => { + let prefix = + "let prompt = " + ++ module_name + ++ "_prompt.prompt\n" + ++ "let exercise: Exercise.spec = "; + let record = show_p(editor_pp, eds); + let data = prefix ++ record ++ "\n"; + data; + }; + + let transitionary_editor_pp = (fmt, editor: Editor.t) => { + let zipper = editor.state.zipper; + let code = Printer.to_string_basic(zipper); + Format.pp_print_string(fmt, "\"" ++ String.escaped(code) ++ "\""); + }; + + let export_transitionary_module = (module_name, {eds, _}: state) => { + let prefix = + "let prompt = " + ++ module_name + ++ "_prompt.prompt\n" + ++ "let exercise: Exercise.spec = Exercise.transition("; + let record = show_p(transitionary_editor_pp, eds); + let data = prefix ++ record ++ ")\n"; + data; + }; + + let export_grading_module = (module_name, {eds, _}: state) => { + let header = output_header_grading(module_name); + let prefix = "let exercise: Exercise.spec = "; + let record = show_p(editor_pp, eds); + let data = header ++ prefix ++ record ++ "\n"; + data; + }; + + let blank_spec = (~title, ~description) => { + // ~module_name, + // ~point_distribution, + // ~required_tests, + // ~provided_tests, + // ~num_wrong_impls, + + // let prelude = Zipper.next_blank(); + // let correct_impl = Zipper.next_blank(); + // let your_tests_tests = Zipper.next_blank(); + let your_impl = Zipper.next_blank(); + // let hidden_bugs = + // List.init( + // num_wrong_impls, + // i => { + // let zipper = Zipper.next_blank(); + // {impl: zipper, hint: "TODO: hint " ++ string_of_int(i)}; + // }, + // ); + let hidden_tests_tests = Zipper.next_blank(); + { + title, + description, + // version: 1, + // module_name, + // prompt: ExerciseEnv.default, + // point_distribution, + // prelude, + // correct_impl, + // your_tests: { + // tests: your_tests_tests, + // required: required_tests, + // provided: provided_tests, + // }, + your_impl, + // hidden_bugs, + hidden_tests: { + tests: hidden_tests_tests, + hints: [], + }, + // syntax_tests: [], + }; + }; + + // From Store + + [@deriving (show({with_path: false}), sexp, yojson)] + type exercise_export = { + cur_exercise: key, + exercise_data: list((key, persistent_state)), + }; + + let serialize_exercise = (exercise, ~instructor_mode) => { + persistent_state_of_state(exercise, ~instructor_mode) + |> sexp_of_persistent_state + |> Sexplib.Sexp.to_string; + }; + + let deserialize_exercise = (data, ~spec, ~instructor_mode) => { + data + |> Sexplib.Sexp.of_string + |> persistent_state_of_sexp + |> unpersist_state(~spec, ~instructor_mode); + }; + + let deserialize_exercise_export = data => { + data |> Sexplib.Sexp.of_string |> exercise_export_of_sexp; + }; +}; diff --git a/src/haz3lschool/Grading.re b/src/haz3lschool/Grading.re index eb94be8aa1..745d1bacd7 100644 --- a/src/haz3lschool/Grading.re +++ b/src/haz3lschool/Grading.re @@ -307,3 +307,312 @@ module F = (ExerciseEnv: Exercise.ExerciseEnv) => { }; }; }; + +// NEW FOR TUTORIAL MODE + +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 = (test_results: option(TestResults.t)) => { + // { + test_results; + // , + // required: eds.hidden_tests.tests, + // 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/DocumentationEnv.re b/src/haz3lweb/DocumentationEnv.re index 0c9737951c..5397f16ead 100644 --- a/src/haz3lweb/DocumentationEnv.re +++ b/src/haz3lweb/DocumentationEnv.re @@ -1,968 +1,10 @@ -open Sexplib.Std; -open Haz3lcore; +open Virtual_dom.Vdom; -module type ExerciseEnv = { - type node; - let default: node; - let output_header: string => string; +module DocEnv = { + type node = Node.t; + let default = Node.text("TODO: prompt"); + let output_header = module_name => + "let prompt = " ++ module_name ++ "_prompt.prompt\n"; }; -let output_header_grading = _module_name => - "module Exercise = GradePrelude.Exercise\n" ++ "let prompt = ()\n"; - -module F = (DocEnv: ExerciseEnv) => { - [@deriving (show({with_path: false}), sexp, yojson)] - type wrong_impl('code) = { - impl: 'code, - hint: string, - }; - - [@deriving (show({with_path: false}), sexp, yojson)] - type hidden_tests('code) = { - tests: 'code, - hints: list(string), - }; - - [@deriving (show({with_path: false}), sexp, yojson)] - type hint = string; - - // [@deriving (show({with_path: false}), sexp, yojson)] - // type syntax_test = (hint, SyntaxTest.predicate); - - // [@deriving (show({with_path: false}), sexp, yojson)] - // type syntax_tests = list(syntax_test); - - [@deriving (show({with_path: false}), sexp, yojson)] - type your_tests('code) = { - tests: 'code, - required: int, - provided: int, - }; - - [@deriving (show({with_path: false}), sexp, yojson)] - type point_distribution = { - test_validation: int, - mutation_testing: int, - impl_grading: int, - }; - - let validate_point_distribution = - ({test_validation, mutation_testing, impl_grading}: point_distribution) => - test_validation + mutation_testing + impl_grading == 100 - ? () : failwith("Invalid point distribution in exercise."); - - [@deriving (show({with_path: false}), sexp, yojson)] - type p('code) = { - title: string, - description: string, - // version: int, - // module_name: string, - // prompt: - // [@printer (fmt, _) => Format.pp_print_string(fmt, "prompt")] [@opaque] ExerciseEnv.node, - // point_distribution, - // prelude: 'code, - // correct_impl: 'code, - // your_tests: your_tests('code), - your_impl: 'code, - // hidden_bugs: list(wrong_impl('code)), - hidden_tests: hidden_tests('code), - // syntax_tests, - }; - - [@deriving (show({with_path: false}), sexp, yojson)] - type key = (string, int); - - let key_of = p => { - p.title; - }; - - let find_key_opt = (key, specs: list(p('code))) => { - specs |> Util.ListUtil.findi_opt(spec => key_of(spec) == key); - }; - - [@deriving (show({with_path: false}), sexp, yojson)] - type pos = - // | Prelude - // | CorrectImpl - // | YourTestsValidation - // | YourTestsTesting - | YourImpl - // | HiddenBugs(int) - | HiddenTests; - - [@deriving (show({with_path: false}), sexp, yojson)] - type spec = p(Zipper.t); - - [@deriving (show({with_path: false}), sexp, yojson)] - type transitionary_spec = p(CodeString.t); - - let map = (p: p('a), f: 'a => 'b): p('b) => { - { - title: p.title, - description: p.description, - // version: p.version, - // module_name: p.module_name, - // prompt: p.prompt, - // point_distribution: p.point_distribution, - // prelude: f(p.prelude), - // correct_impl: f(p.correct_impl), - // your_tests: { - // tests: f(p.your_tests.tests), - // required: p.your_tests.required, - // provided: p.your_tests.provided, - // }, - your_impl: f(p.your_impl), - // hidden_bugs: - // p.hidden_bugs - // |> List.map(wrong_impl => { - // { - // impl: PersistentZipper.persist(wrong_impl.impl), - // hint: wrong_impl.hint, - // } - // }), - hidden_tests: { - tests: PersistentZipper.persist(p.hidden_tests.tests), - hints: p.hidden_tests.hints, - }, - // syntax_tests: p.syntax_tests, - }; - }; - - [@deriving (show({with_path: false}), sexp, yojson)] - type eds = p(Editor.t); - - [@deriving (show({with_path: false}), sexp, yojson)] - type state = { - pos, - eds, - }; - - let key_of_state = ({eds, _}) => key_of(eds); - - [@deriving (show({with_path: false}), sexp, yojson)] - type persistent_state = (pos, list((pos, PersistentZipper.t))); - - let editor_of_state: state => Editor.t = - ({pos, eds, _}) => - switch (pos) { - // | Prelude => eds.prelude - // | CorrectImpl => eds.correct_impl - // | YourTestsValidation => eds.your_tests.tests - // | YourTestsTesting => eds.your_tests.tests - | YourImpl => eds.your_impl - // | HiddenBugs(i) => List.nth(eds.hidden_bugs, i).impl - | HiddenTests => eds.hidden_tests.tests - }; - - let put_editor = ({pos, eds, _} as state: state, editor: Editor.t) => - switch (pos) { - // | Prelude => { - // ...state, - // eds: { - // ...eds, - // prelude: editor, - // }, - // } - // | CorrectImpl => { - // ...state, - // eds: { - // ...eds, - // correct_impl: editor, - // }, - // } - // | YourTestsValidation - // | YourTestsTesting => { - // ...state, - // eds: { - // ...eds, - // your_tests: { - // ...eds.your_tests, - // tests: editor, - // }, - // }, - // } - | YourImpl => { - ...state, - eds: { - ...eds, - your_impl: editor, - }, - } - // | HiddenBugs(n) => { - // ...state, - // eds: { - // ...eds, - // hidden_bugs: - // Util.ListUtil.put_nth( - // n, - // {...List.nth(eds.hidden_bugs, n), impl: editor}, - // eds.hidden_bugs, - // ), - // }, - // } - | HiddenTests => { - ...state, - eds: { - ...eds, - hidden_tests: { - ...eds.hidden_tests, - tests: editor, - }, - }, - } - }; - - let editors = ({eds, _}: state) => - [ - // eds.prelude, - // eds.correct_impl, - // eds.your_tests.tests, - // eds.your_tests.tests, - eds.your_impl, - ] - // @ List.map(wrong_impl => wrong_impl.impl, eds.hidden_bugs) - @ [eds.hidden_tests.tests]; - - let editor_positions = - [YourImpl] - // @ List.mapi((i, _) => HiddenBugs(i), eds.hidden_bugs) - @ [HiddenTests]; - - let positioned_editors = state => - List.combine(editor_positions, editors(state)); - - let idx_of_pos = (pos, p: p('code)) => - switch (pos) { - // | Prelude => 0 - // | CorrectImpl => 1 - // | YourTestsTesting => 2 - // | YourTestsValidation => 3 - | YourImpl => 0 - // | HiddenBugs(i) => - // if (i < List.length(p.hidden_bugs)) { - // 5 + i; - // } else { - // failwith("invalid hidden bug index"); - // } - | HiddenTests => 0 + List.length(p.hidden_tests.tests) // NEED TO FIGURE OUT HOW TO ACTUALLY MAKE THIS WORK - }; - - let pos_of_idx = (p: p('code), idx: int) => - switch (idx) { - // | 0 => Prelude - // | 1 => CorrectImpl - // | 2 => YourTestsTesting - // | 3 => YourTestsValidation - | 0 => YourImpl - | _ => - if (idx < 0) { - failwith( - "negative idx", - // } else if (idx < 5 + List.length(p.hidden_bugs)) { - // HiddenBugs(idx - 5); - ); - } else if (idx == 0 + (+ List.length(p.hidden_tests.tests))) { - HiddenTests; - } else { - failwith("element idx"); - } - }; - - let switch_editor = (~pos, instructor_mode, ~exercise) => - if (!instructor_mode) { - switch (pos) { - | HiddenTests - // | HiddenBugs(_) => exercise - | _ => {eds: exercise.eds, pos} - }; - } else { - {eds: exercise.eds, pos}; - }; - - let zipper_of_code = code => { - switch (Printer.zipper_of_string(code)) { - | None => failwith("Transition failed.") - | Some(zipper) => zipper - }; - }; - - let transition: transitionary_spec => spec = - ( - { - title, - description, - // version, - // module_name, - // prompt, - // point_distribution, - // prelude, - // correct_impl, - // your_tests, - your_impl, - // hidden_bugs, - hidden_tests, - // syntax_tests, - }, - ) => { - // let prelude = zipper_of_code(prelude); - // let correct_impl = zipper_of_code(correct_impl); - // let your_tests = { - // let tests = zipper_of_code(your_tests.tests); - // {tests, required: your_tests.required, provided: your_tests.provided}; - // }; - let your_impl = zipper_of_code(your_impl); - // let hidden_bugs = - // List.fold_left( - // (acc, {impl, hint}) => { - // let impl = zipper_of_code(impl); - // acc @ [{impl, hint}]; - // }, - // [], - // hidden_bugs, - // ); - let hidden_tests = { - let {tests, hints} = hidden_tests; - let tests = zipper_of_code(tests); - {tests, hints}; - }; - { - title, - description, - // version, - // module_name, - // prompt, - // point_distribution, - // prelude, - // correct_impl, - // your_tests, - your_impl, - // hidden_bugs, - hidden_tests, - // syntax_tests, - }; - }; - - let editor_of_serialization = zipper => Editor.init(zipper); - let eds_of_spec: spec => eds = - ( - { - title, - description, - // version, - // module_name, - // prompt, - // point_distribution, - // prelude, - // correct_impl, - // your_tests, - your_impl, - // hidden_bugs, - hidden_tests, - // syntax_tests, - }, - ) => { - // let prelude = editor_of_serialization(prelude); - // let correct_impl = editor_of_serialization(correct_impl); - // let your_tests = { - // let tests = editor_of_serialization(your_tests.tests); - // {tests, required: your_tests.required, provided: your_tests.provided}; - // }; - let your_impl = editor_of_serialization(your_impl); - // let hidden_bugs = - // hidden_bugs - // |> List.map(({impl, hint}) => { - // let impl = editor_of_serialization(impl); - // {impl, hint}; - // }); - let hidden_tests = { - let {tests, hints} = hidden_tests; - let tests = editor_of_serialization(tests); - {tests, hints}; - }; - { - title, - description, - // version, - // module_name, - // prompt, - // point_distribution, - // prelude, - // correct_impl, - // your_tests, - your_impl, - // hidden_bugs, - hidden_tests, - // syntax_tests, - }; - }; - - // FIX ME - - // let set_instructor_mode = ({eds, _} as state: state, new_mode: bool) => { - // ...state, - // eds: { - // ...eds, - // prelude: Editor.set_read_only(eds.prelude, !new_mode), - // }, - // }; - let set_instructor_mode = ({eds, _} as state: state, new_mode: bool) => { - let updated_hidden_tests = { - ...eds.hidden_tests, - tests: Editor.set_read_only(eds.hidden_tests.tests, !new_mode), - }; - - { - ...state, - eds: { - ...eds, - hidden_tests: updated_hidden_tests, - }, - }; - }; - - let visible_in = (pos, ~instructor_mode) => { - switch (pos) { - // | Prelude => instructor_mode - // | CorrectImpl => instructor_mode - // | YourTestsValidation => true - // | YourTestsTesting => false - | YourImpl => true - // | HiddenBugs(_) => instructor_mode - | HiddenTests => instructor_mode - }; - }; - - let state_of_spec = (spec, ~instructor_mode: bool): state => { - let eds = eds_of_spec(spec); - set_instructor_mode({pos: YourImpl, eds}, instructor_mode); - }; - - let persistent_state_of_state = - ({pos, _} as state: state, ~instructor_mode: bool) => { - let zippers = - positioned_editors(state) - |> List.filter(((pos, _)) => visible_in(pos, ~instructor_mode)) - |> List.map(((pos, editor)) => { - (pos, PersistentZipper.persist(Editor.(editor.state.zipper))) - }); - (pos, zippers); - }; - - let unpersist_state = - ( - (pos, positioned_zippers): persistent_state, - ~spec: spec, - ~instructor_mode: bool, - ) - : state => { - let lookup = (pos, default) => - if (visible_in(pos, ~instructor_mode)) { - let persisted_zipper = List.assoc(pos, positioned_zippers); - let zipper = PersistentZipper.unpersist(persisted_zipper); - Editor.init(zipper); - } else { - editor_of_serialization(default); - }; - // let prelude = lookup(Prelude, spec.prelude); - // let correct_impl = lookup(CorrectImpl, spec.correct_impl); - // let your_tests_tests = lookup(YourTestsValidation, spec.your_tests.tests); - let your_impl = lookup(YourImpl, spec.your_impl); - // let (_, hidden_bugs) = - // List.fold_left( - // ((i, hidden_bugs: list(wrong_impl(Editor.t))), {impl, hint}) => { - // let impl = lookup(HiddenBugs(i), impl); - // (i + 1, hidden_bugs @ [{impl, hint}]); - // }, - // (0, []), - // spec.hidden_bugs, - // ); - let hidden_tests_tests = lookup(HiddenTests, spec.hidden_tests.tests); - - set_instructor_mode( - { - pos, - eds: { - title: spec.title, - description: spec.description, - // version: spec.version, - // module_name: spec.module_name, - // prompt: spec.prompt, - // point_distribution: spec.point_distribution, - // prelude, - // correct_impl, - // your_tests: { - // tests: your_tests_tests, - // required: spec.your_tests.required, - // provided: spec.your_tests.provided, - // }, - your_impl, - // hidden_bugs, - hidden_tests: { - tests: hidden_tests_tests, - hints: spec.hidden_tests.hints, - }, - }, - // syntax_tests: spec.syntax_tests, - }, - instructor_mode, - ); - }; - - // # Stitching - - module TermItem = { - type t = { - term: TermBase.UExp.t, - term_ranges: TermRanges.t, - }; - }; - - module StaticsItem = { - type t = CachedStatics.statics; - }; - - type stitched('a) = { - // test_validation: 'a, // prelude + correct_impl + your_tests - user_impl: 'a, // prelude + your_impl - // user_tests: 'a, // prelude + your_impl + your_tests - // prelude: 'a, // prelude - // instructor: 'a, // prelude + correct_impl + hidden_tests.tests // TODO only needs to run in instructor mode - // hidden_bugs: list('a), // prelude + hidden_bugs[i].impl + your_tests, - hidden_tests: 'a, - }; - - let wrap_filter = (act: FilterAction.action, term: Term.UExp.t): Term.UExp.t => - TermBase.UExp.{ - term: - TermBase.UExp.Filter( - FilterAction.(act, One), - {term: Constructor("$e"), ids: [Id.mk()]}, - term, - ), - ids: [Id.mk()], - }; - - let wrap = (term, editor: Editor.t): TermItem.t => { - term, - term_ranges: editor.state.meta.term_ranges, - }; - - let term_of = (editor: Editor.t): Term.UExp.t => - editor.state.meta.view_term; - - let stitch3 = (ed1: Editor.t, ed2: Editor.t, ed3: Editor.t) => - EditorUtil.append_exp( - EditorUtil.append_exp(term_of(ed1), term_of(ed2)), - term_of(ed3), - ); - - let stitch1 = (ed1: Editor.t) => - // EditorUtil.append_exp( - EditorUtil.append_exp(term_of(ed1)); - // term_of(ed3), - // ); - - let stitch_term = ({eds, _}: state): stitched(TermItem.t) => { - // let instructor = - // stitch3(eds.hidden_tests.tests); - let user_impl_term = - // let your_impl_term = - eds.your_impl |> term_of |> wrap_filter(FilterAction.Step); - // }; - // let test_validation_term = - // stitch3(eds.prelude, eds.correct_impl, eds.your_tests.tests); - // let user_tests_term = - // EditorUtil.append_exp(user_impl_term, term_of(eds.your_tests.tests)); - let hidden_tests_term = - EditorUtil.append_exp(user_impl_term, term_of(eds.hidden_tests.tests)); - { - // test_validation: wrap(test_validation_term, eds.your_tests.tests), - user_impl: wrap(user_impl_term, eds.your_impl), - // user_tests: wrap(user_tests_term, eds.your_tests.tests), - // instructor works here as long as you don't shadow anything in the prelude - // prelude: wrap(instructor, eds.prelude), - // instructor: wrap(instructor, eds.correct_impl), - // hidden_bugs: - // List.map( - // (t): TermItem.t => - // // term_of(t.impl), - // wrap(stitch3(eds.prelude, t.impl, eds.your_tests.tests), t.impl), - // eds.hidden_bugs, - // ), - hidden_tests: wrap(hidden_tests_term, eds.hidden_tests.tests), - }; - }; - let stitch_term = Core.Memo.general(stitch_term); - - type stitched_statics = stitched(StaticsItem.t); - - /* Multiple stitchings are needed for each exercise - (see comments in the stitched type above) - - Stitching is necessary to concatenate terms - from different editors, which are then typechecked. */ - let stitch_static = - (settings: CoreSettings.t, t: stitched(TermItem.t)): stitched_statics => { - let mk = ({term, term_ranges, _}: TermItem.t): StaticsItem.t => { - let info_map = Interface.Statics.mk_map(settings, term); - { - term, - error_ids: Statics.Map.error_ids(term_ranges, info_map), - info_map, - }; - }; - // let instructor = mk(t.instructor); - { - // test_validation: mk(t.test_validation), - user_impl: mk(t.user_impl), - // user_tests: mk(t.user_tests), - // prelude: instructor, // works as long as you don't shadow anything in the prelude - // instructor, - // hidden_bugs: List.map(mk, t.hidden_bugs), - hidden_tests: mk(t.hidden_tests), - }; - }; - - let stitch_static = Core.Memo.general(stitch_static); - - let statics_of_stiched = - (state: state, s: stitched(StaticsItem.t)): StaticsItem.t => - switch (state.pos) { - // | Prelude => s.prelude - // | CorrectImpl => s.instructor - // | YourTestsValidation => s.test_validation - // | YourTestsTesting => s.user_tests - | YourImpl => s.user_impl - // | HiddenBugs(idx) => List.nth(s.hidden_bugs, idx) - | HiddenTests => s.hidden_tests - }; - - let statics_of = (~settings, exercise: state): StaticsItem.t => - exercise - |> stitch_term - |> stitch_static(settings) - |> statics_of_stiched(exercise); - - let prelude_key = "prelude"; - let test_validation_key = "test_validation"; - let user_impl_key = "user_impl"; - let user_tests_key = "user_tests"; - let instructor_key = "instructor"; - let hidden_bugs_key = n => "hidden_bugs_" ++ string_of_int(n); - let hidden_tests_key = "hidden_tests"; - - let key_for_statics = (state: state): string => - switch (state.pos) { - // | Prelude => prelude_key - // | CorrectImpl => instructor_key - // | YourTestsValidation => test_validation_key - // | YourTestsTesting => user_tests_key - | YourImpl => user_impl_key - // | HiddenBugs(idx) => hidden_bugs_key(idx) - | HiddenTests => hidden_tests_key - }; - - let spliced_elabs = - (settings: CoreSettings.t, state: state) - : list((ModelResults.key, DHExp.t)) => { - let { - // test_validation, - user_impl, - // user_tests, - // prelude: _, - // instructor, - // hidden_bugs, - hidden_tests, - } = - stitch_static(settings, stitch_term(state)); - let elab = (s: CachedStatics.statics) => - Interface.elaborate(~settings, s.info_map, s.term); - [ - // (test_validation_key, elab(test_validation)), - (user_impl_key, elab(user_impl)), - // (user_tests_key, elab(user_tests)), - // (instructor_key, elab(instructor)), - (hidden_tests_key, elab(hidden_tests)), - ]; - // @ ( - // hidden_bugs - // |> List.mapi((n, hidden_bug: StaticsItem.t) => - // (hidden_bugs_key(n), elab(hidden_bug)) - // ) - // ); - }; - - let mk_statics = - (settings: CoreSettings.t, state: state) - : list((ModelResults.key, StaticsItem.t)) => { - let stitched = stitch_static(settings, stitch_term(state)); - [ - // (prelude_key, stitched.prelude), - // (test_validation_key, stitched.test_validation), - (user_impl_key, stitched.user_impl), - // (user_tests_key, stitched.user_tests), - // (instructor_key, stitched.instructor), - (hidden_tests_key, stitched.hidden_tests), - ]; - // @ List.mapi( - // (n, hidden_bug: StaticsItem.t) => (hidden_bugs_key(n), hidden_bug), - // stitched.hidden_bugs, - // ); - }; - - module DynamicsItem = { - type t = { - term: TermBase.UExp.t, - info_map: Statics.Map.t, - result: ModelResult.t, - }; - let empty: t = { - term: { - term: Tuple([]), - ids: [Id.mk()], - }, - info_map: Id.Map.empty, - result: NoElab, - }; - let statics_only = ({term, info_map, _}: StaticsItem.t): t => { - {term, info_map, result: NoElab}; - }; - }; - - /* Given the evaluation results, collects the - relevant information for producing dynamic - feedback*/ - let stitch_dynamic = - ( - settings: CoreSettings.t, - state: state, - results: option(ModelResults.t), - ) - : stitched(DynamicsItem.t) => { - let { - // test_validation, - user_impl, - // user_tests, - // prelude, - // instructor, - // hidden_bugs, - hidden_tests, - } = - stitch_static(settings, stitch_term(state)); - let result_of = key => - switch (results) { - | None => ModelResult.NoElab - | Some(results) => - ModelResults.lookup(results, key) - |> Option.value(~default=ModelResult.NoElab) - }; - - // let test_validation = - // DynamicsItem.{ - // term: test_validation.term, - // info_map: test_validation.info_map, - // result: result_of(test_validation_key), - // }; - - let user_impl = - DynamicsItem.{ - term: user_impl.term, - info_map: user_impl.info_map, - result: result_of(user_impl_key), - }; - - // let user_tests = - // DynamicsItem.{ - // term: user_tests.term, - // info_map: user_tests.info_map, - // result: result_of(user_tests_key), - // }; - // let prelude = - // DynamicsItem.{ - // term: prelude.term, - // info_map: prelude.info_map, - // result: NoElab, - // }; - // let instructor = - // DynamicsItem.{ - // term: instructor.term, - // info_map: instructor.info_map, - // result: result_of(instructor_key), - // }; - // let hidden_bugs = - // List.mapi( - // (n, statics_item: StaticsItem.t) => - // DynamicsItem.{ - // term: statics_item.term, - // info_map: statics_item.info_map, - // result: result_of(hidden_bugs_key(n)), - // }, - // hidden_bugs, - // ); - let hidden_tests = - DynamicsItem.{ - term: hidden_tests.term, - info_map: hidden_tests.info_map, - result: result_of(hidden_tests_key), - }; - { - // test_validation, - user_impl, - // user_tests, - // instructor, - // prelude, - // hidden_bugs, - hidden_tests, - }; - }; - - let stitch_dynamic = - ( - settings: CoreSettings.t, - state: state, - results: option(ModelResults.t), - ) - : stitched(DynamicsItem.t) => - if (settings.statics && settings.dynamics) { - stitch_dynamic(settings, state, results); - } else if (settings.statics) { - let t = stitch_static(settings, stitch_term(state)); - { - // test_validation: DynamicsItem.statics_only(t.test_validation), - user_impl: DynamicsItem.statics_only(t.user_impl), - // user_tests: DynamicsItem.statics_only(t.user_tests), - // instructor: DynamicsItem.statics_only(t.instructor), - // prelude: DynamicsItem.statics_only(t.prelude), - // hidden_bugs: List.map(DynamicsItem.statics_only, t.hidden_bugs), - hidden_tests: DynamicsItem.statics_only(t.hidden_tests), - }; - } else { - { - // test_validation: DynamicsItem.empty, - user_impl: DynamicsItem.empty, - // user_tests: DynamicsItem.empty, - // instructor: DynamicsItem.empty, - // prelude: DynamicsItem.empty, - // hidden_bugs: - // List.init(List.length(state.eds.hidden_bugs), _ => - // DynamicsItem.empty - // ), - hidden_tests: DynamicsItem.empty, - }; - }; - let stitch_dynamic = Core.Memo.general(stitch_dynamic); - - // Module Export - - let editor_pp = (fmt, editor: Editor.t) => { - let zipper = editor.state.zipper; - let serialization = Zipper.show(zipper); - // let string_literal = "\"" ++ String.escaped(serialization) ++ "\""; - Format.pp_print_string(fmt, serialization); - }; - - let export_module = (module_name, {eds, _}: state) => { - let prefix = - "let prompt = " - ++ module_name - ++ "_prompt.prompt\n" - ++ "let exercise: Exercise.spec = "; - let record = show_p(editor_pp, eds); - let data = prefix ++ record ++ "\n"; - data; - }; - - let transitionary_editor_pp = (fmt, editor: Editor.t) => { - let zipper = editor.state.zipper; - let code = Printer.to_string_basic(zipper); - Format.pp_print_string(fmt, "\"" ++ String.escaped(code) ++ "\""); - }; - - let export_transitionary_module = (module_name, {eds, _}: state) => { - let prefix = - "let prompt = " - ++ module_name - ++ "_prompt.prompt\n" - ++ "let exercise: Exercise.spec = Exercise.transition("; - let record = show_p(transitionary_editor_pp, eds); - let data = prefix ++ record ++ ")\n"; - data; - }; - - let export_grading_module = (module_name, {eds, _}: state) => { - let header = output_header_grading(module_name); - let prefix = "let exercise: Exercise.spec = "; - let record = show_p(editor_pp, eds); - let data = header ++ prefix ++ record ++ "\n"; - data; - }; - - let blank_spec = (~title, ~description) => { - // ~module_name, - // ~point_distribution, - // ~required_tests, - // ~provided_tests, - // ~num_wrong_impls, - - // let prelude = Zipper.next_blank(); - // let correct_impl = Zipper.next_blank(); - // let your_tests_tests = Zipper.next_blank(); - let your_impl = Zipper.next_blank(); - // let hidden_bugs = - // List.init( - // num_wrong_impls, - // i => { - // let zipper = Zipper.next_blank(); - // {impl: zipper, hint: "TODO: hint " ++ string_of_int(i)}; - // }, - // ); - let hidden_tests_tests = Zipper.next_blank(); - { - title, - description, - // version: 1, - // module_name, - // prompt: ExerciseEnv.default, - // point_distribution, - // prelude, - // correct_impl, - // your_tests: { - // tests: your_tests_tests, - // required: required_tests, - // provided: provided_tests, - // }, - your_impl, - // hidden_bugs, - hidden_tests: { - tests: hidden_tests_tests, - hints: [], - }, - // syntax_tests: [], - }; - }; - - // From Store - - [@deriving (show({with_path: false}), sexp, yojson)] - type exercise_export = { - cur_exercise: key, - exercise_data: list((key, persistent_state)), - }; - - let serialize_exercise = (exercise, ~instructor_mode) => { - persistent_state_of_state(exercise, ~instructor_mode) - |> sexp_of_persistent_state - |> Sexplib.Sexp.to_string; - }; - - let deserialize_exercise = (data, ~spec, ~instructor_mode) => { - data - |> Sexplib.Sexp.of_string - |> persistent_state_of_sexp - |> unpersist_state(~spec, ~instructor_mode); - }; - - let deserialize_exercise_export = data => { - data |> Sexplib.Sexp.of_string |> exercise_export_of_sexp; - }; -}; +include Haz3lschool.DocumentationEnv.D(DocEnv); diff --git a/src/haz3lweb/Grading.re b/src/haz3lweb/Grading.re index ac7414a5a1..fd13671070 100644 --- a/src/haz3lweb/Grading.re +++ b/src/haz3lweb/Grading.re @@ -212,7 +212,7 @@ module MutationTestingReport = { // |> Zipper.zip // |> MakeTerm.go // |> fst - // |> Term.UExp.show + // |> UExp.show // |> print_endline // |> (_ => Virtual_dom.Vdom.Effect.Ignore); @@ -337,7 +337,7 @@ module ImplGradingReport = { // let num_passed = num_passed(report); // let status_class = total == num_passed ? "Pass" : "Fail"; // div( - // ~attr= + // ~attrs= // Attr.classes([ // "cell-item", // "test-summary", @@ -453,6 +453,7 @@ module ImplGradingReport = { ); }; }; +// }; module GradingReport = { include GradingReport; @@ -461,3 +462,462 @@ module GradingReport = { score_view(overall_score(report)); }; }; + +// include Haz3lschool.Grading.D(DocumentationEnv.DocEnv); + +// 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), +// ); +// }, +// ] +// }; +// }; + +// 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, +// ) +// ), +// ), +// ), +// ]); +// }; +// }; + +// 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), +// ); +// 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 +// // |> 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 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) +// ), +// ); +// }; + +// 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 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( +// // ~attrs= +// // 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([]) +// }; +// }; + +// let view = (~inject, ~report: t) => { +// Cell.panel( +// ~classes=["cell-item", "panel", "test-panel"], +// [ +// Cell.caption( +// "Implementation Grading", +// ~rest=": Hidden Tests vs. Your Implementation", +// ), +// 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) +// ), +// ), +// ), +// ]), +// ), +// ); +// }; +// }; +// // }; + +// module GradingReport = { +// include GradingReport; + +// let view_overall_score = (report: t) => { +// score_view(overall_score(report)); +// }; +// }; diff --git a/src/haz3lweb/Log.re b/src/haz3lweb/Log.re index 83876619ef..59b3163b59 100644 --- a/src/haz3lweb/Log.re +++ b/src/haz3lweb/Log.re @@ -20,6 +20,7 @@ let is_action_logged: UpdateAction.t => bool = | SwitchScratchSlide(_) | SwitchDocumentationSlide(_) | SwitchEditor(_) + | SwitchEditorDoc(_) | ResetCurrentEditor | ReparseCurrentEditor | PerformAction(_) diff --git a/src/haz3lweb/TutorialGrading.re b/src/haz3lweb/TutorialGrading.re new file mode 100644 index 0000000000..3e0232a815 --- /dev/null +++ b/src/haz3lweb/TutorialGrading.re @@ -0,0 +1,462 @@ +open Virtual_dom.Vdom; +open Node; + +include Haz3lschool.Grading.D(DocumentationEnv.DocEnv); + +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), + ); + }, + ] + }; + }; + + 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, + ) + ), + ), + ), + ]); + }; +}; + +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), + ); + 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 + // |> 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 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) + ), + ); + }; + + 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 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( +// ~attrs= +// 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([]) +// }; +// }; + +let view = { + Cell.panel( + ~classes=["cell-item", "panel", "test-panel"], + [ + Cell.caption( + "Implementation Grading", + ~rest=": Hidden Tests vs. Your Implementation", + ), + // 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) + // ), + // ), + ), + ]), + ), + // }; + ); +}; +// }; + +// module GradingReport = { +// include GradingReport; + +// let view_overall_score = (report: t) => { +// // score_view(overall_score(report)); +// }; +// }; diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 23ba95cf39..41cbc1cd11 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -394,6 +394,12 @@ let rec apply = | None => Error(FailedToSwitch) | Some(editors) => Ok({...model, editors}) }; + | SwitchEditorDoc(_) => Ok(model) // TEMPORARY + // let instructor_mode = model.settings.instructor_mode; + // switch (switch_exercise_editor(model.editors, ~pos, ~instructor_mode)) { + // | None => Error(FailedToSwitch) + // | Some(editors) => Ok({...model, editors}) + // }; | TAB => /* Attempt to act intelligently when TAB is pressed. * TODO(andrew): Consider more advanced TAB logic. Instead diff --git a/src/haz3lweb/UpdateAction.re b/src/haz3lweb/UpdateAction.re index 17856fff80..667473a252 100644 --- a/src/haz3lweb/UpdateAction.re +++ b/src/haz3lweb/UpdateAction.re @@ -69,6 +69,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)) @@ -151,6 +152,7 @@ let is_edit: t => bool = | Reset => true | UpdateResult(_) | SwitchEditor(_) + | SwitchEditorDoc(_) | ExportPersistentData | Save | Copy @@ -206,6 +208,7 @@ let reevaluate_post_update: t => bool = | ExportPersistentData | UpdateResult(_) | SwitchEditor(_) + | SwitchEditorDoc(_) | DebugConsole(_) | TAB | Benchmark(_) => false @@ -256,6 +259,7 @@ let should_scroll_to_caret = | FinishImportAll(_) | ResetCurrentEditor | SwitchEditor(_) + | SwitchEditorDoc(_) | SwitchScratchSlide(_) | SwitchDocumentationSlide(_) | ReparseCurrentEditor diff --git a/src/haz3lweb/view/DocumentationMode.re b/src/haz3lweb/view/DocumentationMode.re new file mode 100644 index 0000000000..61050f4eca --- /dev/null +++ b/src/haz3lweb/view/DocumentationMode.re @@ -0,0 +1,368 @@ +open Haz3lcore; +open Virtual_dom.Vdom; +// open Node; + +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, + ~tutorial, + ~results, + ~highlights, + ) => { + let DocumentationEnv.{eds, pos} = tutorial; + let stitched_dynamics = + DocumentationEnv.stitch_dynamic( + settings.core, + tutorial, + settings.core.dynamics ? Some(results) : None, + ); + let { + // test_validation, + user_impl, + // user_tests, + // prelude, + // instructor, + // hidden_bugs, + hidden_tests: _, + }: + DocumentationEnv.stitched(DocumentationEnv.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: DocumentationEnv.DynamicsItem.t, + this_pos: DocumentationEnv.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=[SwitchEditorDoc(this_pos)], + ~settings, + ~highlights, + ~caption=Cell.caption(caption, ~rest=?subcaption), + ~target_id=DocumentationEnv.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( + // () => + // 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 (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)", + ), + // 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, + // // ), + // ); + + [title_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 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", + );