Ocamlformat

.github/workflows/ci.yml

@@ -7,7 +7,26 @@ on:
   workflow_dispatch:
 
 jobs:
+  lint:
+    runs-on: ubuntu-24.04
+
+    steps:
+      - uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd
+
+      - name: Set up OCaml
+        uses: ocaml/setup-ocaml@44184b0d1ab751e3d1726b13e0afef61d6980755
+        with:
+          ocaml-compiler: 5.4
+          dune-cache: true
+
+      - name: Install dependencies
+        run: opam install ocamlformat.0.28.1 dune
+
+      - name: Check formatting
+        run: opam exec -- dune build @fmt --root test-generator
+
   ci:
+    needs: lint
     runs-on: ubuntu-24.04
 
     steps:

Makefile

@@ -55,8 +55,15 @@ $(ASSIGNMENTS_GEN): test_generator
 
 generate_exercises: $(ASSIGNMENTS_GEN)
 
+# check formatting of test generator files only
+check-formatting:
+	opam exec -- dune build @fmt --root test-generator
+
+format: 
+	cd test-generator && opam exec -- dune fmt
+
 install_deps:
-	opam install dune ounit qcheck fpath react ppx_deriving ppx_sexp_conv yojson ocp-indent calendar core mustache ezjsonm core_unix
+	opam install dune ounit qcheck fpath react ppx_deriving ppx_sexp_conv yojson ocp-indent calendar core mustache ezjsonm core_unix ocamlformat.0.28.1 ocaml-lsp-server
 
 clean:
 	dune clean --root=./test-generator/

test-generator/.ocamlformat

version = 0.28.1
profile = default
version = 0.28.1
@@ -0,0 +1,2 @@
+profile = default
+version = 0.28.1

profile = default
version = 0.28.1

test-generator/bin_data_checker/dune

@@ -5,5 +5,6 @@
   (pps ppx_jane)))
 
 (env
-  (dev
-    (flags (:standard -warn-error -A))))
+ (dev
+  (flags
+   (:standard -warn-error -A))))

test-generator/bin_debug/dune

@@ -5,5 +5,6 @@
   (pps ppx_jane)))
 
 (env
-  (dev
-    (flags (:standard -warn-error -A))))
+ (dev
+  (flags
+   (:standard -warn-error -A))))

test-generator/bin_test_gen/dune

@@ -5,5 +5,6 @@
   (pps ppx_jane)))
 
 (env
-  (dev
-    (flags (:standard -warn-error -A))))
+ (dev
+  (flags
+   (:standard -warn-error -A))))

test-generator/bin_test_gen/test_gen.ml

@@ -6,45 +6,37 @@ let command =
     [%map_open.Command
       let cwd =
         flag_optional_with_default_doc "w" string Sexp.of_string
-          ~aliases:["--cwd"]
-          ~default:(Core_unix.getcwd ()) ~doc:"directory to assume as cwd"
+          ~aliases:[ "--cwd" ] ~default:(Core_unix.getcwd ())
+          ~doc:"directory to assume as cwd"
       and templates_folder =
         flag_optional_with_default_doc "t" string Sexp.of_string
-          ~aliases:["--templates"]
-          ~default:"./templates" ~doc:"directory containing templates"
+          ~aliases:[ "--templates" ] ~default:"./templates"
+          ~doc:"directory containing templates"
       and canonical_data_folder =
         flag_optional_with_default_doc "c" string Sexp.of_string
-          ~aliases:["--canonical"]
+          ~aliases:[ "--canonical" ]
           ~default:"./problem-specifications/exercises"
           ~doc:"directory containing data"
       and output_folder =
         flag_optional_with_default_doc "o" string Sexp.of_string
-          ~aliases:["--output"]
-          ~default:"./exercises/practice"
+          ~aliases:[ "--output" ] ~default:"./exercises/practice"
           ~doc:"directory to output generated tests"
       and _ =
-        flag "f" (optional string)
-          ~aliases:["--filter"]
+        flag "f" (optional string) ~aliases:[ "--filter" ]
           ~doc:"filter out files not matching this string"
       and exercise =
-        flag "e" (optional string)
-          ~aliases:["--exercise"]
+        flag "e" (optional string) ~aliases:[ "--exercise" ]
           ~doc:"exercise to work on"
       and filter_broken =
         flag_optional_with_default_doc "b" bool Bool.sexp_of_t
-          ~aliases:["--filter-broken"]
-          ~default:false
+          ~aliases:[ "--filter-broken" ] ~default:false
           ~doc:"filter_broken Weather or not to process templates with .broken"
       in
       fun () ->
         Sys_unix.chdir cwd;
         ignore
-          (Controller.run
-             ~templates_folder
-             ~canonical_data_folder
-             ?exercise
-             ~filter_broken
-             output_folder
+          (Controller.run ~templates_folder ~canonical_data_folder ?exercise
+             ~filter_broken output_folder
           |> Result.ok_exn)]
 
 let () = Command_unix.run command

test-generator/lib_generator/canonical_data.ml

@@ -1,67 +1,94 @@
 open Core
+
 type json = Yojson.Basic.t
 
 type t = {
-  version: string;
-  exercise: string;
-  comments: string list;
-  cases: json list;
+  version : string;
+  exercise : string;
+  comments : string list;
+  cases : json list;
 }
 
-let get_reimplemented_uuids (cases: Yojson.Basic.t list) : string list =
+let get_reimplemented_uuids (cases : Yojson.Basic.t list) : string list =
   List.filter_map cases ~f:(fun c ->
-    match Yojson.Basic.Util.member "reimplements" c with
-    | `String s -> Some s
-    | _ -> None)
+      match Yojson.Basic.Util.member "reimplements" c with
+      | `String s -> Some s
+      | _ -> None)
 
-let of_string (s: string): t =
+let of_string (s : string) : t =
   let open Yojson.Basic in
   let mem = fun k -> Util.member k (from_string s) in
-  let version = (mem "version") |> Util.to_string_option |> function Some x -> x | None -> "1.0" in
-  let exercise = (mem "exercise") |> Util.to_string in
-  let rec sanitize_cases (c: Yojson.Basic.t list): Yojson.Basic.t list =
-    if List.for_all c ~f:(fun c -> Util.keys c |> List.exists ~f:(fun k -> String.(k = "cases"))) then
+  let version =
+    mem "version" |> Util.to_string_option |> function
+    | Some x -> x
+    | None -> "1.0"
+  in
+  let exercise = mem "exercise" |> Util.to_string in
+  let rec sanitize_cases (c : Yojson.Basic.t list) : Yojson.Basic.t list =
+    if
+      List.for_all c ~f:(fun c ->
+          Util.keys c |> List.exists ~f:(fun k -> String.(k = "cases")))
+    then
       c
-      |> List.map ~f:(fun group -> `Assoc [
-        ("description", Util.member "description" group);
-        ("slug", `String ((Util.member "description" group) |> Util.to_string |> String.lowercase |> String.substr_replace_all ~pattern:" " ~with_:"_" |> String.substr_replace_all ~pattern:"-" ~with_:"_"));
-        ("cases", `List (Util.member "cases" group |> Util.to_list |> sanitize_cases))
-      ])
+      |> List.map ~f:(fun group ->
+          `Assoc
+            [
+              ("description", Util.member "description" group);
+              ( "slug",
+                `String
+                  (Util.member "description" group
+                  |> Util.to_string |> String.lowercase
+                  |> String.substr_replace_all ~pattern:" " ~with_:"_"
+                  |> String.substr_replace_all ~pattern:"-" ~with_:"_") );
+              ( "cases",
+                `List
+                  (Util.member "cases" group |> Util.to_list |> sanitize_cases)
+              );
+            ])
       |> List.map ~f:(Special_cases.edit_case ~slug:exercise)
     else
       c
       |> List.filter_map ~f:(fun c ->
-        let c = Special_cases.edit_case ~slug:exercise c in
-      (Util.member "input" c)
-        |> (fun a -> try Some (Util.to_assoc a) with Util.Type_error _ -> None)
-        |> Option.map ~f:(fun params -> ("expected", Util.member "expected" c) :: params) (* mix .expected onto .input.expected to retain backward compat *)
-        |> Option.bind ~f:(Special_cases.edit_parameters ~slug:exercise)
-        |> Option.map ~f:(fun l -> `Assoc (List.map l ~f:(fun (k, v) -> (k, `String v))))
-        |> Option.map ~f:(fun i -> `Assoc (("input", i) :: (Util.to_assoc c |> List.filter ~f:(fun (k, _) -> String.(k <> "input" && k <> "expected"))))
-      )
-  ) 
+          let c = Special_cases.edit_case ~slug:exercise c in
+          Util.member "input" c
+          |> (fun a ->
+          try Some (Util.to_assoc a) with Util.Type_error _ -> None)
+          |> Option.map ~f:(fun params ->
+              ("expected", Util.member "expected" c) :: params)
+            (* mix .expected onto .input.expected to retain backward compat *)
+          |> Option.bind ~f:(Special_cases.edit_parameters ~slug:exercise)
+          |> Option.map ~f:(fun l ->
+              `Assoc (List.map l ~f:(fun (k, v) -> (k, `String v))))
+          |> Option.map ~f:(fun i ->
+              `Assoc
+                (("input", i)
+                :: (Util.to_assoc c
+                   |> List.filter ~f:(fun (k, _) ->
+                       String.(k <> "input" && k <> "expected"))))))
   in
 
-  let cases = (mem "cases") |> Util.to_list |> sanitize_cases in
+  let cases = mem "cases" |> Util.to_list |> sanitize_cases in
 
   (* filter original cases whose UUID is referenced in "reimplements" *)
   let reimplemented_uuids = get_reimplemented_uuids cases in
   let filtered_cases =
     List.filter cases ~f:(fun c ->
-      match Util.member "uuid" c with
-      | `String uuid -> not (List.mem reimplemented_uuids uuid ~equal:String.equal)
-      | _ -> true
-    )
+        match Util.member "uuid" c with
+        | `String uuid ->
+            not (List.mem reimplemented_uuids uuid ~equal:String.equal)
+        | _ -> true)
   in
 
   {
     version;
     exercise;
-    comments = (try (mem "comments") |> Util.to_list |> List.map ~f:Util.to_string with _ -> []);
-    cases = filtered_cases
+    comments =
+      (try mem "comments" |> Util.to_list |> List.map ~f:Util.to_string
+       with _ -> []);
+    cases = filtered_cases;
   }
 
-let rec yo_to_ez (j: Yojson.Basic.t): Ezjsonm.value =
+let rec yo_to_ez (j : Yojson.Basic.t) : Ezjsonm.value =
   match j with
   | `Null -> `Null
   | `Bool b -> `Bool b
@@ -71,13 +98,13 @@ let rec yo_to_ez (j: Yojson.Basic.t): Ezjsonm.value =
   | `String s -> `String s
   | `Assoc l -> `O (List.map l ~f:(fun (k, v) -> (k, yo_to_ez v)))
 
-let to_json (d: t): Mustache.Json.t =
-  `O [
-    ("name", `String d.exercise);
-    ("version", `String d.version);
-    ("comments", `A (List.map d.comments ~f:(fun c -> `String c)));
-    ("cases", `A (List.map d.cases ~f:yo_to_ez))
-  ]
+let to_json (d : t) : Mustache.Json.t =
+  `O
+    [
+      ("name", `String d.exercise);
+      ("version", `String d.version);
+      ("comments", `A (List.map d.comments ~f:(fun c -> `String c)));
+      ("cases", `A (List.map d.cases ~f:yo_to_ez));
+    ]
 
-let to_string (d: t): string =
-  to_json d |> Ezjsonm.to_string ~minify:true
+let to_string (d : t) : string = to_json d |> Ezjsonm.to_string ~minify:true

test-generator/lib_generator/controller.ml

@@ -1,32 +1,36 @@
 open Core
 
-let run
-    ?(exercise: string option)
-    ~(templates_folder: string)
-    ~(canonical_data_folder: string)
-    ?(filter_broken: bool option)
-    (output_folder: string) =
-
-    let filter_broken = match filter_broken with Some x -> x | None -> false in
-    let exercise_filter = exercise |> function
-      | Some x -> fun (canidate: Exercise_candidate.t) -> String.equal x canidate.name
-      | None -> fun _ -> true
-    in
-    Files.find_files canonical_data_folder ~glob:["*canonical-data.json"]
-    |> List.map ~f:Exercise_candidate.of_path
-    |> List.filter ~f:exercise_filter
-    |> List.filter ~f:(fun (e: Exercise_candidate.t) -> match filter_broken with | true -> not(e.is_broken ~tpl:templates_folder) | false -> true)
-    |> List.filter ~f:(fun (e: Exercise_candidate.t) -> e.is_implemented ~tpl:templates_folder)
-    |> List.map ~f:(Exercise.of_candidate ~tpl:templates_folder ~out:output_folder)
-    |> List.concat_map ~f:(fun (e: Exercise.t) ->
-      List.map e.templates ~f:(fun (t: Template.t) ->
-        let path = Files.append_path output_folder t.relative_path |> Files.strip_ext in
-        Template.render t ~data:e.canonical_data
-        |> (fun r -> if String.((Files.ext path) = ".ml") then Template.format r else r)
-        |> Files.write_file ~path
-      ))
-    |> Result.all
-
+let run ?(exercise : string option) ~(templates_folder : string)
+    ~(canonical_data_folder : string) ?(filter_broken : bool option)
+    (output_folder : string) =
+  let filter_broken = match filter_broken with Some x -> x | None -> false in
+  let exercise_filter =
+    exercise |> function
+    | Some x ->
+        fun (canidate : Exercise_candidate.t) -> String.equal x canidate.name
+    | None -> fun _ -> true
+  in
+  Files.find_files canonical_data_folder ~glob:[ "*canonical-data.json" ]
+  |> List.map ~f:Exercise_candidate.of_path
+  |> List.filter ~f:exercise_filter
+  |> List.filter ~f:(fun (e : Exercise_candidate.t) ->
+      match filter_broken with
+      | true -> not (e.is_broken ~tpl:templates_folder)
+      | false -> true)
+  |> List.filter ~f:(fun (e : Exercise_candidate.t) ->
+      e.is_implemented ~tpl:templates_folder)
+  |> List.map
+       ~f:(Exercise.of_candidate ~tpl:templates_folder ~out:output_folder)
+  |> List.concat_map ~f:(fun (e : Exercise.t) ->
+      List.map e.templates ~f:(fun (t : Template.t) ->
+          let path =
+            Files.append_path output_folder t.relative_path |> Files.strip_ext
+          in
+          Template.render t ~data:e.canonical_data
+          |> (fun r ->
+          if String.(Files.ext path = ".ml") then Template.format r else r)
+          |> Files.write_file ~path))
+  |> Result.all
 
 (* bin_data_checker calls this, but does not exist *)
 let check_canonical_data _ = failwith "not implemented"

test-generator/lib_generator/dune

@@ -5,5 +5,6 @@
   (pps ppx_jane)))
 
 (env
-  (dev
-    (flags (:standard -warn-error -A))))
+ (dev
+  (flags
+   (:standard -warn-error -A))))