feat(grader): Show a status line on what is being built

This makes it easier to identify problem when one exercise is misbehaving (see
ocaml-sf/learn-ocaml-corpus@b6e1f61)

Author: AltGr

src/repo/learnocaml_process_exercise_repository.ml

@@ -47,6 +47,22 @@ let dump_dot exs =
 
 let n_processes = ref 1
 
+let grading_status, grading_status_add, grading_status_remove =
+  let in_progress = ref [] in
+  let tty = Unix.isatty Unix.stderr in
+  let show () =
+    match !in_progress with
+    | [] -> flush stderr
+    | prog ->
+        Printf.eprintf "Grading in progress: %s" (String.concat " " prog);
+        if tty then (flush stderr; prerr_string "\r\027[K") else prerr_newline ()
+  in
+  show,
+  (fun id -> in_progress := !in_progress @ [id]; show ()),
+  (fun id ->
+     in_progress := List.filter (fun x -> not (String.equal x id)) !in_progress;
+     show ())
+
 let print_grader_error exercise = function
   | Ok () -> ()
   | Error (-1) -> ()
@@ -59,7 +75,7 @@ let print_grader_error exercise = function
 
 let spawn_grader
     dump_outputs dump_reports
-    ?print_result ?dirname meta ex_dir output_json =
+    ?print_result ?dirname id meta ex_dir output_json =
   let rec sleep () =
     if !n_processes <= 0 then
       Lwt.pause () >>= sleep
@@ -70,15 +86,18 @@ let spawn_grader
   sleep () >>= fun () ->
   Lwt.catch (fun () ->
       read_exercise ex_dir >>= fun exercise ->
+      grading_status_add id;
       Grader_cli.grade
         ~dump_outputs ~dump_reports ~display_callback:false
         ?print_result ?dirname meta exercise output_json
       >|= fun r ->
+      grading_status_remove id;
       print_grader_error exercise r;
       incr n_processes;
       r)
     (fun e ->
        incr n_processes;
+       grading_status_remove id;
        Printf.eprintf "Grader error: %s\n%!" (Printexc.to_string e);
        Lwt.return (Error 0))
 
@@ -214,7 +233,7 @@ let main dest_dir =
            if !n_processes = 1 then
              Lwt_list.map_s,
              fun dump_outputs dump_reports ?print_result ?dirname
-               meta ex_dir json_path ->
+               _id meta ex_dir json_path ->
                read_exercise ex_dir >>= fun exercise ->
                Grader_cli.grade
                  ~dump_outputs ~dump_reports ~display_callback:true
@@ -236,21 +255,22 @@ let main dest_dir =
                  else Lwt.return_unit)
                  (Lwt_unix.files_of_directory ex_dir) >>= fun () ->
                if not changed then begin
-                 Format.printf "%-24s (no changes)@." id ;
+                 Format.eprintf "%-24s (no changes)@." id ;
                  Lwt.return_true
                end else begin
                  Learnocaml_precompile_exercise.precompile ~exercise_dir:ex_dir
                  >>= fun () ->
                  grade dump_outputs dump_reports
-                   ~dirname:ex_dir (Index.find index id) ex_dir (Some json_path)
+                   ~dirname:ex_dir id (Index.find index id) ex_dir (Some json_path)
                  >>= function
                  | Ok () ->
-                     Format.printf "%-24s     [OK]@." id ;
+                     Format.eprintf "%-24s     [OK]@." id ;
                      Lwt.return true
                  | Error _ ->
-                     Format.printf "%-24s   [FAILED]@." id ;
+                     Format.eprintf "%-24s   [FAILED]@." id ;
                      Lwt.return false
-               end)
+               end
+                 >|= fun r -> grading_status (); r)
              processes_arguments
        end >>= fun results ->
        Lwt.return (List.for_all ((=) true) results))