feat: Add new transformation to ppx-metaquot that introduces the register_sampler calls

.gitignore

@@ -35,3 +35,8 @@ tests/corpuses/*
 detect-libs.*
 
 docs/odoc.html
+
+demo-repository/exercises/**/*.cmo
+demo-repository/exercises/**/*.cmi
+demo-repository/exercises/**/*.cma
+demo-repository/exercises/**/*.js

dune

@@ -7,7 +7,7 @@
 )
 
 (env
-  (release (flags -safe-string -w +a-4-42-44-45-48-3-58)
+  (release (flags -safe-string -w +a-4-42-44-45-48-3-58-32-33)
            (ocamlc_flags)
            (ocamlopt_flags))
 )

dune-project

@@ -1,4 +1,4 @@
-(lang dune 2.3)
+(lang dune 2.4)
 (name learn-ocaml)
 (version 0.13.2)
 (allow_approximate_merlin)

src/app/learnocaml_description_main.ml

@@ -66,12 +66,12 @@ let () =
      match get_encoded_token () with
      | Some { arg_name = _; raw_arg = _; token } -> begin
          let exercise_fetch =
-           retrieve (Learnocaml_api.Exercise (Some token, id))
+           retrieve (Learnocaml_api.Exercise (Some token, id, true))
          in
          init_tabs ();
          exercise_fetch >>= fun (ex_meta, exo, _deadline) ->
          (* display exercise questions and prelude *)
-         setup_tab_text_prelude_pane Learnocaml_exercise.(decipher File.prelude exo);
+         setup_tab_text_prelude_pane Learnocaml_exercise.(decipher File.prelude_ml exo);
          let text_iframe = Dom_html.createIframe Dom_html.document in
          Manip.replaceChildren title_container
            Tyxml_js.Html5.[ h1 [ txt ex_meta.title] ];

src/app/learnocaml_exercise_main.ml

@@ -119,20 +119,25 @@ let () =
     Js.string (id ^ " - " ^ "Learn OCaml" ^" v."^ Learnocaml_api.version);
   let exercise_fetch =
     token >>= fun token ->
-    retrieve (Learnocaml_api.Exercise (token, id))
+    retrieve (Learnocaml_api.Exercise (token, id, true))
   in
   let after_init top =
     exercise_fetch >>= fun (_meta, exo, _deadline) ->
-    begin match Learnocaml_exercise.(decipher File.prelude exo) with
-      | "" -> Lwt.return true
-      | prelude ->
-          Learnocaml_toplevel.load ~print_outcome:true top
-            ~message: [%i"loading the prelude..."]
-            prelude
-    end >>= fun r1 ->
-    Learnocaml_toplevel.load ~print_outcome:false top
-      (Learnocaml_exercise.(decipher File.prepare exo)) >>= fun r2 ->
-    if not r1 || not r2 then failwith [%i"error in prelude"] ;
+    let exercise_js = Learnocaml_exercise.(decipher File.exercise_js exo) in
+    Learnocaml_toplevel.load_cmi_from_string top
+      Learnocaml_exercise.(decipher File.prelude_cmi exo) >>= fun _ ->
+    Learnocaml_toplevel.load_cmi_from_string top
+      Learnocaml_exercise.(decipher File.prepare_cmi exo) >>= fun _ ->
+    Learnocaml_toplevel.load_js ~print_outcome:false top
+      ~message: [%i"loading the prelude..."]
+      exercise_js
+    >>= fun r ->
+    if not r then Lwt.fail_with  [%i"error in prelude"] else
+    Learnocaml_toplevel.load top "open! Prelude ;;" >>= fun r ->
+    if not r then Lwt.fail_with [%i"error in prelude"] else
+    Learnocaml_toplevel.load top "open! Prepare ;;" >>= fun r ->
+    if not r then Lwt.fail_with [%i"error in prelude"] else
+    (* TODO: maybe remove Prelude, Prepare modules from the env ? *)
     Learnocaml_toplevel.set_checking_environment top >>= fun () ->
     Lwt.return () in
   let toplevel_launch =
@@ -188,7 +193,7 @@ let () =
   EB.eval top select_tab;
   let typecheck = typecheck top ace editor in
 (*------------- prelude -----------------*)
-  setup_prelude_pane ace Learnocaml_exercise.(decipher File.prelude exo);
+  setup_prelude_pane ace Learnocaml_exercise.(decipher File.prelude_ml exo);
   Js.Opt.case
     (text_iframe##.contentDocument)
     (fun () -> failwith "cannot edit iframe document")

src/app/learnocaml_student_view.ml

@@ -484,7 +484,7 @@ let () =
     | None -> ()
     | Some ex_id ->
         Lwt.async @@ fun () ->
-        retrieve (Learnocaml_api.Exercise (Some teacher_token, ex_id))
+        retrieve (Learnocaml_api.Exercise (Some teacher_token, ex_id, true))
         >>= fun (meta, exo, _) ->
         clear_tabs ();
         let ans = SMap.find_opt ex_id save.Save.all_exercise_states in

src/app/server_caller.ml

@@ -114,8 +114,8 @@ let fetch_lesson_index () =
 let fetch_lesson id =
   request_exn (Learnocaml_api.Lesson id)
 
-let fetch_exercise token id =
-  request_exn (Learnocaml_api.Exercise (token,id))
+let fetch_exercise token id js =
+  request_exn (Learnocaml_api.Exercise (token,id,js))
 
 let fetch_tutorial_index () =
   request_exn (Learnocaml_api.Tutorial_index ())

src/app/server_caller.mli

@@ -24,7 +24,7 @@ exception Cannot_fetch of string
 val request_exn: 'a Learnocaml_api.request -> 'a Lwt.t
 
 val[@deprecated] fetch_exercise:
-  Token.t option -> Exercise.id -> (Exercise.Meta.t * Exercise.t * float option) Lwt.t
+  Token.t option -> Exercise.id -> bool -> (Exercise.Meta.t * Exercise.t * float option) Lwt.t
 
 val[@deprecated] fetch_lesson_index: unit -> Lesson.Index.t Lwt.t
 val[@deprecated] fetch_lesson : string -> Lesson.t Lwt.t

src/grader/dune

@@ -13,8 +13,41 @@
  (action (run odoc compile --package learn-ocaml %{deps} -o %{targets}))
 )
 
+;; needs to be a separate lib because the module is shared between evaluator
+;; parts (Grading) and dynamic parts (Test_lib)
 (library
- (name testing)
+ (name introspection_intf)
+ (wrapped false)
+ (modules introspection_intf)
+ (modules_without_implementation introspection_intf)
+ (libraries learnocaml_report ty))
+
+;; dynamic part, on which Prelude/Prepare/Test_lib etc. depend
+(library
+ (name learnocaml_callback)
+ (wrapped false)
+ (modules learnocaml_callback)
+ (modules_without_implementation learnocaml_callback)
+ ;; hack: learnocaml_callback actually does have an implementation, but it is inserted
+ ;; into the toplevel later on, through registered callbacks. Defining this lib
+ ;; ensures the compilation of `learnocaml_callback.cmi`
+ (libraries compiler-libs learnocaml_report introspection_intf))
+
+;; dynamic part, on which Test_lib depends
+(library
+ (name pre_test)
+ (wrapped false)
+ (modules pre_test)
+ (modules_without_implementation pre_test)
+ ;; hack: pre_test actually does have an implementation, but it is dynamically
+ ;; generated and injected in the environment during grading. We are interested
+ ;; in pre_test.cmi to compile test_lib.cmo, then test_lib.cmo should only be
+ ;; loaded in the specific grading toplevel env.
+ (libraries compiler-libs learnocaml_report introspection_intf))
+
+;; dynamic (but pre-compiled) part
+(library
+ (name testing_dyn)
  (wrapped false)
  (modes byte)
  (library_flags :standard -linkall)
@@ -24,18 +57,23 @@
             learnocaml_ppx_metaquot_lib
             ocplib-json-typed
             learnocaml_report
-            learnocaml_repository)
- (modules Introspection_intf
-          Introspection
-          Test_lib
-          Mutation_test)
- (modules_without_implementation Introspection_intf)
+            learnocaml_repository
+            introspection_intf
+            ;; dynamic dependencies
+            learnocaml_callback
+            pre_test
+            )
+ (modules Test_lib)
  (preprocess (pps learnocaml_ppx_metaquot))
 )
+(rule
+ (target testing_dyn.js)
+ (deps testing_dyn.cma)
+ (action (run js_of_ocaml %{deps} --wrap-with dynload --pretty)))
 
 (rule
  (targets test_lib.odoc)
- (deps .testing.objs/byte/test_lib.cmti)
+ (deps .testing_dyn.objs/byte/test_lib.cmti)
  (action (run odoc compile --package learn-ocaml %{deps} -o %{targets}))
 )
 
@@ -138,39 +176,47 @@
 )
 
 (rule
- (targets embedded_grading_cmis.ml)
- (deps (:compiler-cmis
-        %{ocaml-config:standard_library}/compiler-libs/longident.cmi
-        %{ocaml-config:standard_library}/compiler-libs/asttypes.cmi
-        %{ocaml-config:standard_library}/compiler-libs/ast_helper.cmi
-        %{ocaml-config:standard_library}/compiler-libs/ast_mapper.cmi
-        %{ocaml-config:standard_library}/compiler-libs/parsetree.cmi
-        %{ocaml-config:standard_library}/compiler-libs/location.cmi
-        %{ocaml-config:standard_library}/compiler-libs/parse.cmi
-        %{ocaml-config:standard_library}/compiler-libs/pprintast.cmi)
-       (:generated-cmis
-        ../ppx-metaquot/.ty.objs/byte/ty.cmi
-        ../ppx-metaquot/.fun_ty.objs/byte/fun_ty.cmi
-        .testing.objs/byte/introspection_intf.cmi
-        .learnocaml_report.objs/byte/learnocaml_report.cmi
-        .testing.objs/byte/test_lib.cmi
-        .testing.objs/byte/mutation_test.cmi))
+ (targets embedded_grading_lib.ml)
+ (deps
+  .learnocaml_callback.objs/byte/learnocaml_callback.cmi
+  ;; .pre_test.objs/byte/pre_test.cmi -- only test_lib should be needed
+  .testing_dyn.objs/byte/test_lib.cmi
+  testing_dyn.cma
+  testing_dyn.js)
  (action (with-stdout-to %{targets}
-           (run ocp-ocamlres -format ocamlres %{compiler-cmis} %{generated-cmis})))
+           (run ocp-ocamlres -format ocamlres %{deps})))
+)
+
+;; cmis that are needed to precompile the graders for exercises
+(install
+ (section share)
+ (package learn-ocaml)
+ (files
+  (../ppx-metaquot/.ty.objs/byte/ty.cmi as grading_cmis/ty.cmi)
+  (../ppx-metaquot/.fun_ty.objs/byte/fun_ty.cmi as grading_cmis/fun_ty.cmi)
+  (.introspection_intf.objs/byte/introspection_intf.cmi as grading_cmis/introspection_intf.cmi)
+  (.pre_test.objs/byte/pre_test.cmi as grading_cmis/pre_test.cmi)
+  (.learnocaml_report.objs/byte/learnocaml_report.cmi as grading_cmis/learnocaml_report.cmi)
+  (.learnocaml_callback.objs/byte/learnocaml_callback.cmi as grading_cmis/learnocaml_callback.cmi)
+  (.testing_dyn.objs/byte/test_lib.cmi as grading_cmis/test_lib.cmi))
 )
 
+
 (library
  (name grading)
  (wrapped false)
  (modes byte)
  (library_flags :standard -linkall)
- (libraries testing
-            learnocaml_ppx_metaquot
+ (libraries learnocaml_ppx_metaquot
             ocplib-ocamlres.runtime
+            toploop
+            introspection_intf
             embedded_cmis
             ocplib_i18n
-            learnocaml_report)
- (modules Embedded_grading_cmis
+            learnocaml_report
+            learnocaml_repository)
+ (modules Introspection
+          Embedded_grading_lib
           Grading)
  (preprocess (per_module ((pps ppx_ocplib_i18n learnocaml_ppx_metaquot) Grading)))
 )

src/grader/grader_cli.ml

@@ -7,9 +7,6 @@
  * included LICENSE file for details. *)
 
 let display_std_outputs = ref false
-let dump_outputs = ref None
-let dump_reports = ref None
-let display_callback = ref false
 let display_outcomes = ref false
 let grade_student = ref None
 let individual_timeout = ref None
@@ -30,7 +27,7 @@ let read_exercise exercise_dir =
   in
   Learnocaml_exercise.read_lwt ~read_field
     ~id:(Filename.basename exercise_dir)
-    ~decipher:false ()
+    ()
 
 let remove_trailing_slash s =
   let len = String.length s in
@@ -47,29 +44,25 @@ let read_student_file exercise_dir path =
   else
     Lwt_io.with_file ~mode:Lwt_io.Input fn Lwt_io.read
 
-let grade ?(print_result=false) ?dirname meta exercise output_json =
+let grade ?(print_result=false) ?dirname
+    ~dump_outputs ~dump_reports ~display_callback
+    meta exercise output_json =
   Lwt.catch
     (fun () ->
        let code_to_grade = match !grade_student with
          | Some path -> read_student_file (Sys.getcwd ()) path
-         | None ->
-             Lwt.return (Learnocaml_exercise.(decipher File.solution exercise)) in
+         | None -> Lwt.return (Learnocaml_exercise.(decipher File.solution exercise)) in
        let callback =
-         if !display_callback then Some (Printf.eprintf "[ %s ]%!\r\027[K") else None in
+         if display_callback then Some (Printf.eprintf "[ %s ]%!\r\027[K") else None in
        let timeout = !individual_timeout in
        code_to_grade >>= fun code ->
        Grading_cli.get_grade ?callback ?timeout ?dirname exercise code
        >>= fun (result, stdout_contents, stderr_contents, outcomes) ->
        flush stderr;
        match result with
-       | Error exn ->
+       | Error err ->
            let dump_error ppf =
-             begin match Grading.string_of_exn exn with
-               | Some msg ->
-                   Format.fprintf ppf "%s@." msg
-               | None ->
-                   Format.fprintf ppf "%a@." Location.report_exception exn
-             end;
+             Format.fprintf ppf "%s@." (Grading.string_of_err err);
              if stdout_contents <> "" then begin
                Format.fprintf ppf "grader stdout:@.%s@." stdout_contents
              end ;
@@ -79,7 +72,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
              if outcomes <> "" then begin
                Format.fprintf ppf "grader outcomes:@.%s@." outcomes
              end in
-           begin match !dump_outputs with
+           begin match dump_outputs with
              | None -> ()
              | Some prefix ->
                  let oc = open_out (prefix ^ ".error") in
@@ -92,7 +85,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
            let (max, failure) = Learnocaml_report.result report in
            if !display_reports then
              Learnocaml_report.print (Format.formatter_of_out_channel stderr) report;
-           begin match !dump_reports with
+           begin match dump_reports with
              | None -> ()
              | Some prefix ->
                  let oc = open_out (prefix ^ ".report.txt") in
@@ -103,7 +96,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                  close_out oc
            end ;
            if stderr_contents <> "" then begin
-             begin match !dump_outputs with
+             begin match dump_outputs with
                | None -> ()
                | Some prefix ->
                    let oc = open_out (prefix ^ ".stderr") in
@@ -114,7 +107,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                Format.eprintf "%s" stderr_contents
            end ;
            if stdout_contents <> "" then begin
-             begin match !dump_outputs with
+             begin match dump_outputs with
                | None -> ()
                | Some prefix ->
                    let oc = open_out (prefix ^ ".stdout") in
@@ -125,7 +118,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                Format.printf "%s" stdout_contents
            end ;
            if outcomes <> "" then begin
-             begin match !dump_outputs with
+             begin match dump_outputs with
                | None -> ()
                | Some prefix ->
                    let oc = open_out (prefix ^ ".outcomes") in
@@ -163,7 +156,8 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                  Lwt.return (Ok ())
            end)
     (fun exn ->
-       begin match !dump_outputs with
+       Lwt.wrap @@ fun () ->
+       begin match dump_outputs with
          | None -> ()
          | Some prefix ->
              let oc = open_out (prefix ^ ".error") in
@@ -172,15 +166,20 @@ let grade ?(print_result=false) ?dirname meta exercise output_json =
                "%a@!" Location.report_exception exn ;
              close_out oc
        end ;
-       Format.eprintf "%a" Location.report_exception exn ;
-       Lwt.return (Error (-1)))
+       Format.eprintf "%a" Location.report_exception exn;
+       Error (-1))
 
-let grade_from_dir ?(print_result=false) exercise_dir output_json =
+let grade_from_dir
+    ?(print_result=false)
+    ~dump_outputs ~dump_reports ~display_callback
+    exercise_dir output_json =
   let exercise_dir = remove_trailing_slash exercise_dir in
   read_exercise exercise_dir >>= fun exo ->
   Lwt_io.(with_file ~mode:Input (String.concat Filename.dir_sep [exercise_dir; "meta.json"]) read) >>= fun content ->
   let meta = (match content with
               | "" -> `O []
               | s -> Ezjsonm.from_string s)
              |> Json_encoding.destruct Learnocaml_data.Exercise.Meta.enc in
-  grade ~print_result ~dirname:exercise_dir meta exo output_json
+  grade
+    ~dump_outputs ~dump_reports ~display_callback
+    ~print_result ~dirname:exercise_dir meta exo output_json