feat: Add ppx-recorder that introduces the register_sampler calls

* New ppx called ppx-recorder that inserts `let () = Introspection.register_sampler name fun`
  for each toplevel binding prefixed with `sample_*` in test.ml. This ppx is applied during the
  precompilation of exercises.

* Compilation units stored in `demo-repository/exercises/exercise_name/` during the
  precompilation are no longer staged.

Author: hernoufM

.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

src/grader/grading_cli.mli

@@ -7,7 +7,7 @@
  * included LICENSE file for details. *)
 
 (** Take an exercise, a solution, and return the report, stdout,
-    stderr and outcomes of the toplevel, or raise ont of the
+    stderr and outcomes of the toplevel, or raise one of the
     exceptions defined in module {!Grading}. *)
 val get_grade:
   ?callback:(string -> unit) ->

src/ppx-recorder/dune

@@ -0,0 +1,26 @@
+(library
+ (name ppx_recorder_lib)
+ (wrapped false)
+ (flags :standard -w -27)
+ (modules Ppx_recorder)
+ (preprocess (pps learnocaml_ppx_metaquot))
+ (libraries ppxlib))
+
+(library
+ (name ppx_recorder)
+ (wrapped false)
+ (modules Ppx_recorder_register)
+ (kind ppx_rewriter)
+ (libraries ppx_recorder_lib))
+
+(executable
+ (name ppx_recorder_main)
+ (modules Ppx_recorder_main)
+ (libraries ppx_recorder))
+
+(install
+ (section libexec)
+ (package learn-ocaml)
+ (files
+  (ppx_recorder_main.exe as grading_ppx/learnocaml-ppx-recorder))
+)

src/ppx-recorder/ppx_recorder.ml

@@ -0,0 +1,42 @@
+open Ppxlib
+
+let rec get_samplers bindings acc =
+  match bindings with
+  | [] -> List.rev acc
+  | binding :: rest -> (
+      match binding.pvb_pat.ppat_desc with
+      | Ppat_var var -> (
+          match String.index_opt var.txt '_' with
+          | Some i when String.sub var.txt 0 i = "sample" ->
+              let suffix =
+                String.sub var.txt (i + 1) (String.length var.txt - i - 1)
+              in
+              get_samplers rest (suffix :: acc)
+          | _ -> get_samplers rest acc)
+      | _ -> get_samplers rest acc)
+
+let sampler_recorder s =
+  let create_sampler_registration name sampler =
+    [%stri let () = Introspection.register_sampler [%e name] [%e sampler]]
+  in
+  List.fold_right
+    (fun si acc ->
+      match si.pstr_desc with
+      | Pstr_value (_, bindings) -> (
+          match get_samplers bindings [] with
+          | [] -> si :: acc
+          | samplers ->
+              let sampler_registration =
+                List.map
+                  (fun sampler ->
+                    create_sampler_registration
+                      (Ast_builder.Default.estring ~loc:Location.none sampler)
+                      (Ast_builder.Default.evar ~loc:Location.none
+                         ("sample_" ^ sampler)))
+                  samplers
+              in
+              (si :: sampler_registration) @ acc)
+      | _ -> si :: acc)
+    s []
+
+let expand = sampler_recorder

src/ppx-recorder/ppx_recorder_main.ml

@@ -0,0 +1,2 @@
+let () = 
+    Ppxlib.Driver.run_as_ppx_rewriter ()

src/ppx-recorder/ppx_recorder_register.ml

@@ -0,0 +1,2 @@
+let () =
+  Ppxlib.Driver.register_transformation "sample_recorder" ~impl:Ppx_recorder.expand

src/repo/learnocaml_precompile_exercise.ml

@@ -61,7 +61,8 @@ let precompile ~exercise_dir =
      jsoo ~dir [] ~source:"exercise.cma" ~target:"exercise.js");
     (ocamlc ~dir ["-c";
                   "-I"; "+compiler-libs";
-                  "-ppx"; Filename.concat !grading_ppx_dir "learnocaml-ppx-metaquot" ]
+                  "-ppx"; Filename.concat !grading_ppx_dir "learnocaml-ppx-metaquot";
+                  "-ppx"; Filename.concat !grading_ppx_dir "learnocaml-ppx-recorder"]
        ~opn:["Learnocaml_callback"; "Prelude"; "Prepare"; "Test_lib.Open_me"]
        ~source:["test.ml"]
        ~target:"test.cmo"

src/toploop/toploop_unix.mli

@@ -33,7 +33,7 @@ val flush_redirected_channel : redirection -> unit
 (** Flushes the channel and then cancel the redirection.
     The redirection must be the last one performed, otherwise an
     [Invalid_argument] will be raised.
-    A stack of redirections is maintained for all fire descriptors. So
+    A stack of redirections is maintained for all file descriptors. So
     the channel is then restored to either the previous redirection or
     to the original file descriptor. *)
 val stop_channel_redirection : redirection -> unit