From cc6e7561843f9c346ea16c9bbbd63ccf34e4b34d Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 10 Mar 2026 16:00:49 +0100 Subject: [PATCH 01/14] add file to enable auto code formatting --- .ocamlformat | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 .ocamlformat diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000000..e69de29bb2 From fee0137997f37e3e76b312b11b3b3d47e50f4999 Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 10 Mar 2026 16:10:28 +0100 Subject: [PATCH 02/14] install ocamlformat and ocaml-lsp-server --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index f095343aed..4cae44f8e5 100644 --- a/Makefile +++ b/Makefile @@ -56,7 +56,7 @@ $(ASSIGNMENTS_GEN): test_generator generate_exercises: $(ASSIGNMENTS_GEN) 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 ocaml-lsp-server clean: dune clean --root=./test-generator/ From 65e39e4d5613151a9df53a28ddc372a5fbeb7627 Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 10 Mar 2026 16:11:16 +0100 Subject: [PATCH 03/14] add manual file formatting command --- Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Makefile b/Makefile index 4cae44f8e5..2c9c7af605 100644 --- a/Makefile +++ b/Makefile @@ -55,6 +55,8 @@ $(ASSIGNMENTS_GEN): test_generator generate_exercises: $(ASSIGNMENTS_GEN) +fmt: 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 ocamlformat ocaml-lsp-server From 4e7ab61088b524a50eee9a1886e03b8b55e6d77b Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 10 Mar 2026 16:45:29 +0100 Subject: [PATCH 04/14] make commands for checking and formatting code only apply to the test-generator directory for now --- Makefile | 6 +++++- test-generator/.ocamlformat | 0 2 files changed, 5 insertions(+), 1 deletion(-) create mode 100644 test-generator/.ocamlformat diff --git a/Makefile b/Makefile index 2c9c7af605..85b7d3f3f6 100644 --- a/Makefile +++ b/Makefile @@ -55,7 +55,11 @@ $(ASSIGNMENTS_GEN): test_generator generate_exercises: $(ASSIGNMENTS_GEN) -fmt: opam exec -- dune fmt +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 ocamlformat ocaml-lsp-server diff --git a/test-generator/.ocamlformat b/test-generator/.ocamlformat new file mode 100644 index 0000000000..e69de29bb2 From f851ca26b4e3cbf4db980c93f68f8e995dcc4b3c Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 10 Mar 2026 16:46:17 +0100 Subject: [PATCH 05/14] remove old ocamlformat file --- .ocamlformat | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 .ocamlformat diff --git a/.ocamlformat b/.ocamlformat deleted file mode 100644 index e69de29bb2..0000000000 From 12e3f0af09df21b63d524e3220b0aae2e437b6b5 Mon Sep 17 00:00:00 2001 From: Owen Date: Thu, 12 Mar 2026 12:22:23 +0100 Subject: [PATCH 06/14] update ocamlformat to use default profile and specific version --- test-generator/.ocamlformat | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test-generator/.ocamlformat b/test-generator/.ocamlformat index e69de29bb2..b24f4b152a 100644 --- a/test-generator/.ocamlformat +++ b/test-generator/.ocamlformat @@ -0,0 +1,2 @@ +profile = default +version = 0.28.1 \ No newline at end of file From 175b775fe580f2ad169d9ab42b53958f3435d19c Mon Sep 17 00:00:00 2001 From: Owen Date: Thu, 12 Mar 2026 12:24:44 +0100 Subject: [PATCH 07/14] install ocamlformat 0.28.1 --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 85b7d3f3f6..6bdc84d955 100644 --- a/Makefile +++ b/Makefile @@ -62,7 +62,7 @@ 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 ocamlformat ocaml-lsp-server + 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/ From 254c8e9a8231ae9d62c6a0550f060eed07c44f92 Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 24 Mar 2026 13:07:05 +0100 Subject: [PATCH 08/14] format all test generator files --- test-generator/bin_data_checker/dune | 5 +- test-generator/bin_debug/dune | 5 +- test-generator/bin_test_gen/dune | 5 +- test-generator/bin_test_gen/test_gen.ml | 30 +- .../lib_generator/canonical_data.ml | 115 ++- test-generator/lib_generator/controller.ml | 58 +- test-generator/lib_generator/dune | 5 +- test-generator/lib_generator/exercise.ml | 26 +- .../lib_generator/exercise_candidate.ml | 48 +- test-generator/lib_generator/files.ml | 74 +- test-generator/lib_generator/generator.ml | 1 - test-generator/lib_generator/glob.ml | 74 +- test-generator/lib_generator/model.ml | 56 +- test-generator/lib_generator/special_cases.ml | 883 ++++++++++-------- test-generator/lib_generator/template.ml | 40 +- test-generator/test/all_tests.ml | 10 +- test-generator/test/dune | 9 +- test-generator/test/model_test.ml | 10 +- test-generator/test/special_cases_test.ml | 70 +- 19 files changed, 838 insertions(+), 686 deletions(-) diff --git a/test-generator/bin_data_checker/dune b/test-generator/bin_data_checker/dune index 0d7469c9b5..7670e2a323 100644 --- a/test-generator/bin_data_checker/dune +++ b/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)))) diff --git a/test-generator/bin_debug/dune b/test-generator/bin_debug/dune index cbfbd3ae08..35b8db64ca 100644 --- a/test-generator/bin_debug/dune +++ b/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)))) diff --git a/test-generator/bin_test_gen/dune b/test-generator/bin_test_gen/dune index 9ac73d2bbe..fb880f8cb8 100644 --- a/test-generator/bin_test_gen/dune +++ b/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)))) diff --git a/test-generator/bin_test_gen/test_gen.ml b/test-generator/bin_test_gen/test_gen.ml index dc54e749e8..f95501e25b 100644 --- a/test-generator/bin_test_gen/test_gen.ml +++ b/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 diff --git a/test-generator/lib_generator/canonical_data.ml b/test-generator/lib_generator/canonical_data.ml index f1f035d15b..526a15048f 100644 --- a/test-generator/lib_generator/canonical_data.ml +++ b/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 diff --git a/test-generator/lib_generator/controller.ml b/test-generator/lib_generator/controller.ml index dc5fb93290..580d8ab8b5 100644 --- a/test-generator/lib_generator/controller.ml +++ b/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" diff --git a/test-generator/lib_generator/dune b/test-generator/lib_generator/dune index 76f185b35f..90b6d9989a 100644 --- a/test-generator/lib_generator/dune +++ b/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)))) diff --git a/test-generator/lib_generator/exercise.ml b/test-generator/lib_generator/exercise.ml index 668c86e392..89aa8b6158 100644 --- a/test-generator/lib_generator/exercise.ml +++ b/test-generator/lib_generator/exercise.ml @@ -1,30 +1,32 @@ open Core type t = { - name: string; (* unique name *) - directory: string; (* target directory *) - description: string option; (* description.md contents *) - canonical_data: Canonical_data.t; (* canonical_data.json data *) - templates: Template.t list; (* all templates *) + name : string; (* unique name *) + directory : string; (* target directory *) + description : string option; (* description.md contents *) + canonical_data : Canonical_data.t; (* canonical_data.json data *) + templates : Template.t list; (* all templates *) } -let of_candidate ~(tpl: string) ~(out: string) (c: Exercise_candidate.t): t = +let of_candidate ~(tpl : string) ~(out : string) (c : Exercise_candidate.t) : t + = { name = c.name; directory = Files.append_path out c.name; - description = (c.get_description ()); + description = c.get_description (); canonical_data = Result.ok_exn (c.get_data ()); - templates = (c.get_templates ~tpl) + templates = c.get_templates ~tpl; } -let to_string (e: t): string = +let to_string (e : t) : string = let print_description = function | None -> "None" | Some d -> Printf.sprintf "%s" d in - Printf.sprintf "ExerciseCandidate { name = \"%s\"; directory = \"%s\"; description = \"%s\"; canonical_data = %s; templates = %s }" - e.name - e.directory + Printf.sprintf + "ExerciseCandidate { name = \"%s\"; directory = \"%s\"; description = \ + \"%s\"; canonical_data = %s; templates = %s }" + e.name e.directory (print_description e.description) (Canonical_data.to_string e.canonical_data) (List.map e.templates ~f:Template.to_string |> String.concat ~sep:"; ") diff --git a/test-generator/lib_generator/exercise_candidate.ml b/test-generator/lib_generator/exercise_candidate.ml index 41293b8c34..00234c0a73 100644 --- a/test-generator/lib_generator/exercise_candidate.ml +++ b/test-generator/lib_generator/exercise_candidate.ml @@ -1,28 +1,39 @@ open Core type t = { - name: string; - directory: string; - get_templates: tpl:string -> Template.t list; - get_data: unit -> (Canonical_data.t, exn) result; - get_description: unit -> string option; - is_broken: tpl:string -> bool; - is_implemented: tpl:string -> bool; - has_data: unit -> bool; - has_templates: tpl:string -> bool; + name : string; + directory : string; + get_templates : tpl:string -> Template.t list; + get_data : unit -> (Canonical_data.t, exn) result; + get_description : unit -> string option; + is_broken : tpl:string -> bool; + is_implemented : tpl:string -> bool; + has_data : unit -> bool; + has_templates : tpl:string -> bool; } -let of_path (p: string): t = +let of_path (p : string) : t = let name = Files.get_parent_name p in let directory = Files.get_parent_string p in let get_template_dir = fun ~tpl -> Files.append_path tpl name in - let get_template_files = fun ~tpl -> - try Files.find_files (get_template_dir ~tpl) ~glob:["*.tpl*"] - with Core_unix.Unix_error(Core_unix.ENOENT, _, _) -> [] + let get_template_files = + fun ~tpl -> + try Files.find_files (get_template_dir ~tpl) ~glob:[ "*.tpl*" ] + with Core_unix.Unix_error (Core_unix.ENOENT, _, _) -> [] + in + let get_templates = + fun ~tpl -> get_template_files ~tpl |> List.map ~f:(Template.of_path ~tpl) + in + let get_data = + fun () -> Files.read_file p |> Result.map ~f:Canonical_data.of_string + in + let get_description = + fun () -> + try + Files.read_file (Files.append_path directory "description.md") + |> Result.ok + with _ -> None in - let get_templates = fun ~tpl -> get_template_files ~tpl |> List.map ~f:(Template.of_path ~tpl) in - let get_data = fun () -> Files.read_file p |> Result.map ~f:Canonical_data.of_string in - let get_description = fun () -> try Files.read_file (Files.append_path directory "description.md") |> Result.ok with _ -> None in let has_data = fun () -> Files.read_file p |> Result.is_ok in let has_templates = fun ~tpl -> List.length (get_template_files ~tpl) > 0 in let is_implemented = fun ~tpl -> has_data () && has_templates ~tpl in @@ -39,5 +50,6 @@ let of_path (p: string): t = has_templates; } -let to_string (e: t): string = - Printf.sprintf "ExerciseCandidate { name = \"%s\"; directory = \"%s\"; }" e.name e.directory +let to_string (e : t) : string = + Printf.sprintf "ExerciseCandidate { name = \"%s\"; directory = \"%s\"; }" + e.name e.directory diff --git a/test-generator/lib_generator/files.ml b/test-generator/lib_generator/files.ml index 9af96b9461..e6c9c6d855 100644 --- a/test-generator/lib_generator/files.ml +++ b/test-generator/lib_generator/files.ml @@ -22,14 +22,14 @@ let ls_dir dir = f [] (Core_unix.opendir dir) let mkdir_if_not_present dir = - if not (file_exists dir) - then begin + if not (file_exists dir) then begin Core_unix.mkdir dir ~perm:0o750; print_endline @@ "Storing generated files in " ^ dir end else () -let backup ~(base_folder: string) ~(slug: string) ~(contents: string): bool = +let backup ~(base_folder : string) ~(slug : string) ~(contents : string) : bool + = mkdir_if_not_present base_folder; let path = Filename.concat base_folder slug in let matches_contents = @@ -37,71 +37,61 @@ let backup ~(base_folder: string) ~(slug: string) ~(contents: string): bool = |> Option.map ~f:(String.equal contents) |> Option.value ~default:false in - if matches_contents - then false + if matches_contents then false else begin Out_channel.write_all path ~data:contents; true end -let path_exn (p: string): Fpath.t = - Fpath.of_string p |> Result.map_error ~f:(function `Msg m -> m) |> Result.ok_or_failwith +let path_exn (p : string) : Fpath.t = + Fpath.of_string p + |> Result.map_error ~f:(function `Msg m -> m) + |> Result.ok_or_failwith -let rec find_files (base: string) ~(glob: string list): string list = - base - |> ls_dir +let rec find_files (base : string) ~(glob : string list) : string list = + base |> ls_dir |> List.filter ~f:(fun p -> String.(p <> ".") && String.(p <> "..")) |> List.map ~f:(fun p -> base ^ "/" ^ p) |> List.concat_map ~f:(fun p -> - if is_directory p then - find_files p ~glob - else if List.for_all glob ~f:(fun g -> Glob.matches g p) then - [p] - else - []) + if is_directory p then find_files p ~glob + else if List.for_all glob ~f:(fun g -> Glob.matches g p) then [ p ] + else []) -let is_broken (p: string): bool = - match find_files p ~glob:[".broken"] with - | [] -> false - | _ -> true +let is_broken (p : string) : bool = + match find_files p ~glob:[ ".broken" ] with [] -> false | _ -> true -let get_parent (p: string): Fpath.t = - path_exn p |> Fpath.parent +let get_parent (p : string) : Fpath.t = path_exn p |> Fpath.parent +let get_parent_name (p : string) : string = get_parent p |> Fpath.basename +let get_parent_string (p : string) : string = get_parent p |> Fpath.to_string -let get_parent_name (p: string): string = - get_parent p |> Fpath.basename +let group_by_parent (ps : string list) : string list list = + List.group ps ~break:(fun a b -> + String.(get_parent_string a <> get_parent_string b)) -let get_parent_string (p: string): string = - get_parent p |> Fpath.to_string - -let group_by_parent (ps: string list): string list list = - List.group ps ~break:(fun a b -> String.(get_parent_string a <> get_parent_string b)) - -let append_path (a: string) (b: string): string = +let append_path (a : string) (b : string) : string = (path_exn a |> Fpath.to_dir_path |> Fpath.to_string) ^ b -let relative_path (a: string) (b: string): string = - Option.value_exn (Fpath.relativize ~root:(path_exn a) (path_exn b)) |> Fpath.to_string +let relative_path (a : string) (b : string) : string = + Option.value_exn (Fpath.relativize ~root:(path_exn a) (path_exn b)) + |> Fpath.to_string -let read_file (p: string): (string, exn) Result.t = +let read_file (p : string) : (string, exn) Result.t = let b = Buffer.create 0 in try let c = Stdio.In_channel.create p in while true do Buffer.add_string b (In_channel.input_line_exn c); - Buffer.add_char b '\n'; + Buffer.add_char b '\n' done; failwith "unreachable" with End_of_file -> Ok (Buffer.contents b) -let write_file ~(path: string) (data: string): (unit, exn) Result.t = +let write_file ~(path : string) (data : string) : (unit, exn) Result.t = Result.try_with (fun () -> - mkdir_if_not_present (get_parent_string path); - Stdio.Out_channel.write_all path ~data - ) + mkdir_if_not_present (get_parent_string path); + Stdio.Out_channel.write_all path ~data) -let strip_ext (path: string): string = +let strip_ext (path : string) : string = path_exn path |> Fpath.rem_ext |> Fpath.to_string -let ext (path: string): string = - path_exn path |> Fpath.get_ext ~multi:true +let ext (path : string) : string = path_exn path |> Fpath.get_ext ~multi:true diff --git a/test-generator/lib_generator/generator.ml b/test-generator/lib_generator/generator.ml index de4f17fcce..7cda5a7136 100644 --- a/test-generator/lib_generator/generator.ml +++ b/test-generator/lib_generator/generator.ml @@ -16,7 +16,6 @@ end module Exercise_candidate = struct include Exercise_candidate - end module Exercise = Exercise diff --git a/test-generator/lib_generator/glob.ml b/test-generator/lib_generator/glob.ml index fd6abd7544..35e70cd428 100644 --- a/test-generator/lib_generator/glob.ml +++ b/test-generator/lib_generator/glob.ml @@ -1,45 +1,43 @@ open Core let split c s = - let len = String.length s in - let rec loop acc last_pos pos = - if pos = -1 then - String.sub s ~pos:0 ~len:last_pos :: acc - else - if Char.equal (String.get s pos) c then - let pos1 = pos + 1 in - let sub_str = String.sub s ~pos:pos1 ~len:(last_pos - pos1) in - loop (sub_str :: acc) pos (pos - 1) - else loop acc last_pos (pos - 1) - in - loop [] len (len - 1) + let len = String.length s in + let rec loop acc last_pos pos = + if pos = -1 then String.sub s ~pos:0 ~len:last_pos :: acc + else if Char.equal (String.get s pos) c then + let pos1 = pos + 1 in + let sub_str = String.sub s ~pos:pos1 ~len:(last_pos - pos1) in + loop (sub_str :: acc) pos (pos - 1) + else loop acc last_pos (pos - 1) + in + loop [] len (len - 1) (** Returns list of indices of occurances of substr in x *) -let find_substrings ?(start_point=0) substr x = - let len_s = String.length substr and len_x = String.length x in - let rec aux acc i = - if len_x - i < len_s - then acc - else - if String.equal (String.sub x ~pos:i ~len:len_s) substr - then aux (i::acc) (i + 1) - else aux acc (i + 1) - in - aux [] start_point +let find_substrings ?(start_point = 0) substr x = + let len_s = String.length substr and len_x = String.length x in + let rec aux acc i = + if len_x - i < len_s then acc + else if String.equal (String.sub x ~pos:i ~len:len_s) substr then + aux (i :: acc) (i + 1) + else aux acc (i + 1) + in + aux [] start_point let matches glob x = - let rec contains_all_sections = function - | _, [] | _, [""] -> true - | i, [g] -> (* need to find a match that matches to end of string *) - find_substrings ~start_point:i g x - |> List.exists ~f:(fun j -> j + String.length g = String.length x) - | 0, ""::g::gs -> - find_substrings g x - |> List.exists ~f:(fun j -> contains_all_sections ((j + (String.length g)), gs)) - | i, g::gs -> - find_substrings ~start_point:i g x - |> List.exists ~f:(fun j -> - (if i = 0 then j = 0 else true) - && contains_all_sections ((j + (String.length g)), gs)) - in - contains_all_sections (0, (split '*' glob)) + let rec contains_all_sections = function + | _, [] | _, [ "" ] -> true + | i, [ g ] -> + (* need to find a match that matches to end of string *) + find_substrings ~start_point:i g x + |> List.exists ~f:(fun j -> j + String.length g = String.length x) + | 0, "" :: g :: gs -> + find_substrings g x + |> List.exists ~f:(fun j -> + contains_all_sections (j + String.length g, gs)) + | i, g :: gs -> + find_substrings ~start_point:i g x + |> List.exists ~f:(fun j -> + (if i = 0 then j = 0 else true) + && contains_all_sections (j + String.length g, gs)) + in + contains_all_sections (0, split '*' glob) diff --git a/test-generator/lib_generator/model.ml b/test-generator/lib_generator/model.ml index e60f8c50f4..444c418222 100644 --- a/test-generator/lib_generator/model.ml +++ b/test-generator/lib_generator/model.ml @@ -3,49 +3,49 @@ open Core type json = Yojson.Basic.t type case = { - description: string; - parameters: (string * json) list; - property: string; + description : string; + parameters : (string * json) list; + property : string; } -type test = {name: string; cases: case list} +type test = { name : string; cases : case list } +type tests = Single of case list | Suite of test list +type canonical_data = { version : string option; tests : tests } -type tests = - | Single of case list - | Suite of test list - -type canonical_data = { - version: string option; - tests: tests -} - -let rec json_to_string (j: json): string = match j with +let rec json_to_string (j : json) : string = + match j with | `Null -> "null" - | `String s -> "\"" ^ (String.escaped s) ^ "\"" + | `String s -> "\"" ^ String.escaped s ^ "\"" | `Float f -> Float.to_string f | `Int n -> Int.to_string n | `Bool b -> Bool.to_string b - | `List xs -> "[" ^ String.concat ~sep:"; " (List.map ~f:json_to_string xs) ^ "]" - | `Assoc xs -> "[" ^ String.concat ~sep:"; " - (List.map xs ~f:(fun (k,v) -> "(\"" ^ String.escaped k ^ "\", " ^ json_to_string v ^ ")")) ^ "]" + | `List xs -> + "[" ^ String.concat ~sep:"; " (List.map ~f:json_to_string xs) ^ "]" + | `Assoc xs -> + "[" + ^ String.concat ~sep:"; " + (List.map xs ~f:(fun (k, v) -> + "(\"" ^ String.escaped k ^ "\", " ^ json_to_string v ^ ")")) + ^ "]" let list_to_string = String.concat ~sep:"; " -let json_assoc_to_string (xs: (string * json) list): string = - List.map xs ~f:(fun (k, j) -> k ^ ": " ^ (json_to_string j)) - |> list_to_string +let json_assoc_to_string (xs : (string * json) list) : string = + List.map xs ~f:(fun (k, j) -> k ^ ": " ^ json_to_string j) |> list_to_string -let case_to_string {description; parameters; property}: string = - "{description: " ^ description ^ "; parameters: " ^ (json_assoc_to_string parameters) ^ "; property: " ^ (property) ^ "}" +let case_to_string { description; parameters; property } : string = + "{description: " ^ description ^ "; parameters: " + ^ json_assoc_to_string parameters + ^ "; property: " ^ property ^ "}" let cases_to_string cases = list_to_string (List.map ~f:case_to_string cases) -let test_to_string {name; cases}: string = - "{name: " ^ name ^ "; cases: " ^ (cases_to_string cases) ^ "}" +let test_to_string { name; cases } : string = + "{name: " ^ name ^ "; cases: " ^ cases_to_string cases ^ "}" -let tests_to_string tests: string = +let tests_to_string tests : string = "[" ^ list_to_string (List.map tests ~f:test_to_string) ^ "]" let tests_to_string = function -| Single case -> cases_to_string case -| Suite tests -> tests_to_string tests + | Single case -> cases_to_string case + | Suite tests -> tests_to_string tests diff --git a/test-generator/lib_generator/special_cases.ml b/test-generator/lib_generator/special_cases.ml index dd5e1b0537..6bc397e116 100644 --- a/test-generator/lib_generator/special_cases.ml +++ b/test-generator/lib_generator/special_cases.ml @@ -1,5 +1,4 @@ open Core - open Model open Yojson.Basic open Yojson.Basic.Util @@ -8,546 +7,672 @@ type json = Yojson.Basic.t let strip_quotes s = String.drop_prefix s 1 |> Fn.flip String.drop_suffix 1 -let two_elt_list_to_tuple (j: json): string = match j with - | `List [`Int x1; `Int x2] -> Printf.sprintf "(%d,%d)" x1 x2 - | _ -> failwith "two element list expected, but got " ^ (json_to_string j) +let two_elt_list_to_tuple (j : json) : string = + match j with + | `List [ `Int x1; `Int x2 ] -> Printf.sprintf "(%d,%d)" x1 x2 + | _ -> failwith "two element list expected, but got " ^ json_to_string j -let map_elements (to_str: json -> string) (parameters: (string * json) list): (string * string) list = - List.map parameters ~f:(fun (k,j) -> (k,to_str j)) +let map_elements (to_str : json -> string) (parameters : (string * json) list) : + (string * string) list = + List.map parameters ~f:(fun (k, j) -> (k, to_str j)) -let optional_int ~(none: int) = function +let optional_int ~(none : int) = function | `Int n when n = none -> "None" | `Int n -> "(Some " ^ Int.to_string n ^ ")" | x -> json_to_string x let optional_int_list = function - | `List xs -> "(Some [" ^ String.concat ~sep:"; " (List.map ~f:json_to_string xs) ^ "])" + | `List xs -> + "(Some [" ^ String.concat ~sep:"; " (List.map ~f:json_to_string xs) ^ "])" | _ -> "None" -let optional_int_or_string ~(none: int) = function +let optional_int_or_string ~(none : int) = function | `String s -> "(Some \"" ^ s ^ "\")" | `Int n when n = none -> "None" | x -> json_to_string x -let default_value ~(key: string) ~(value: string) (parameters: (string * string) list): (string * string) list = - if List.exists ~f:(fun (k, _) -> String.(k = key)) parameters - then parameters +let default_value ~(key : string) ~(value : string) + (parameters : (string * string) list) : (string * string) list = + if List.exists ~f:(fun (k, _) -> String.(k = key)) parameters then parameters else (key, value) :: parameters -let optional_strings ~(f: string -> bool) (parameters: (string * json) list): (string * string) list = +let optional_strings ~(f : string -> bool) (parameters : (string * json) list) : + (string * string) list = let replace parameter = - let (k, v) = parameter in - if f k - then (k, "(Some " ^ json_to_string v ^ ")") - else (k, json_to_string v) in + let k, v = parameter in + if f k then (k, "(Some " ^ json_to_string v ^ ")") else (k, json_to_string v) + in List.map ~f:replace parameters -let option_of_null (value: json): string = match value with +let option_of_null (value : json) : string = + match value with | `Null -> "None" | `String s -> "(Some \"" ^ s ^ "\")" - | `List _ as l -> "(Some " ^ (json_to_string l) ^ ")" + | `List _ as l -> "(Some " ^ json_to_string l ^ ")" | x -> failwith "cannot handle this type: " ^ json_to_string x -let is_empty_string (value: json): bool = match value with - | `String s -> String.is_empty s - | _ -> false +let is_empty_string (value : json) : bool = + match value with `String s -> String.is_empty s | _ -> false -let edit_phone_number_expected (value: json) = match value with +let edit_phone_number_expected (value : json) = + match value with | `String s -> "(Ok \"" ^ s ^ "\")" - | `Assoc [("error", v)] -> "(Error " ^ json_to_string v ^ ")" + | `Assoc [ ("error", v) ] -> "(Error " ^ json_to_string v ^ ")" | x -> failwith "Bad json value in change " ^ json_to_string x let edit_hamming_expected = function | `Int n -> "(Ok " ^ Int.to_string n ^ ")" - | `Assoc [("error", `String m)] ->" (Error \"" ^ m ^ "\")" + | `Assoc [ ("error", `String m) ] -> " (Error \"" ^ m ^ "\")" | x -> json_to_string x -let edit_change_expected (value: json) = match value with - | `List xs -> "(Some [" ^ (String.concat ~sep:"; " (List.map ~f:json_to_string xs)) ^ "])" - | `Assoc [("error", _)] -> "None" - | `Int (-1) -> "None" +let edit_change_expected (value : json) = + match value with + | `List xs -> + "(Some [" ^ String.concat ~sep:"; " (List.map ~f:json_to_string xs) ^ "])" + | `Assoc [ ("error", _) ] -> "None" + | `Int -1 -> "None" | _ -> failwith "Bad json value in change" -let edit_bowling_expected (value: json) = match value with - | `Int n -> "(Ok " ^ (Int.to_string n) ^ ")" - | `Assoc [(k, v)] -> - if String.(k = "error") then "(Error " ^ json_to_string v ^ ")" else failwith ("Can only handle error value but got " ^ k) +let edit_bowling_expected (value : json) = + match value with + | `Int n -> "(Ok " ^ Int.to_string n ^ ")" + | `Assoc [ (k, v) ] -> + if String.(k = "error") then "(Error " ^ json_to_string v ^ ")" + else failwith ("Can only handle error value but got " ^ k) | _ -> failwith "Bad json value in bowling" -let edit_forth_expected (value: json) = match value with - | `List xs -> "(Some [" ^ (String.concat ~sep:"; " (List.map ~f:json_to_string xs)) ^ "])" - | `Assoc [("error", _)] -> "None" +let edit_forth_expected (value : json) = + match value with + | `List xs -> + "(Some [" ^ String.concat ~sep:"; " (List.map ~f:json_to_string xs) ^ "])" + | `Assoc [ ("error", _) ] -> "None" | x -> failwith "Bad json value in change " ^ json_to_string x let edit_beer_song_expected = function - | `List xs -> xs - |> List.map ~f:(function - | `String s -> s - | x -> json_to_string x) - |> String.concat ~sep:(String.escaped "\n") - |> Printf.sprintf "\"%s\"" - | x -> json_to_string x |> Printf.sprintf "Bad json value in beer-song %s" |> failwith - -let edit_say (ps: (string * json) list) = + | `List xs -> + xs + |> List.map ~f:(function `String s -> s | x -> json_to_string x) + |> String.concat ~sep:(String.escaped "\n") + |> Printf.sprintf "\"%s\"" + | x -> + json_to_string x + |> Printf.sprintf "Bad json value in beer-song %s" + |> failwith + +let edit_say (ps : (string * json) list) = let edit = function - | ("number", `Int v) when v >= 0 -> ("number", Printf.sprintf "%iL" v) - | ("number", `Int v) when v < 0 -> ("number", Printf.sprintf "(%iL)" v) - | ("expected", `Assoc [("error", v)]) -> ("expected", "(Error " ^ json_to_string v ^ ")") - | ("expected", v) -> ("expected", "(Ok " ^ json_to_string v ^ ")") - | (k, ps) -> (k, json_to_string ps) in + | "number", `Int v when v >= 0 -> ("number", Printf.sprintf "%iL" v) + | "number", `Int v when v < 0 -> ("number", Printf.sprintf "(%iL)" v) + | "expected", `Assoc [ ("error", v) ] -> + ("expected", "(Error " ^ json_to_string v ^ ")") + | "expected", v -> ("expected", "(Ok " ^ json_to_string v ^ ")") + | k, ps -> (k, json_to_string ps) + in List.map ps ~f:edit -let edit_triangle (ps: (string * json) list): (string * string) list option = +let edit_triangle (ps : (string * json) list) : (string * string) list option = let edit = function - | ("sides", `List l) -> ("sides", l |> List.map ~f:json_to_string |> String.concat ~sep:" ") - | (k, v) -> (k, json_to_string v) in + | "sides", `List l -> + ("sides", l |> List.map ~f:json_to_string |> String.concat ~sep:" ") + | k, v -> (k, json_to_string v) + in let int_sides = function - | ("sides", `List l) -> l |> List.for_all ~f:(function `Int _ -> true | _ -> false) - | (_, _) -> false + | "sides", `List l -> + l |> List.for_all ~f:(function `Int _ -> true | _ -> false) + | _, _ -> false in - if List.exists ps ~f:int_sides then - List.map ps ~f:edit |> Option.return - else - None + if List.exists ps ~f:int_sides then List.map ps ~f:edit |> Option.return + else None -let edit_all_your_base (ps: (string * json) list): (string * string) list = +let edit_all_your_base (ps : (string * json) list) : (string * string) list = let edit = function - | ("outputBase", v) -> let v = json_to_string v in ("outputBase", if Int.of_string v >= 0 then v else "(" ^ v ^ ")") - | ("inputBase", v) -> let v = json_to_string v in ("inputBase", if Int.of_string v >= 0 then v else "(" ^ v ^ ")") - | ("expected", v) -> ("expected", optional_int_list v) - | (k, v) -> (k, json_to_string v) in + | "outputBase", v -> + let v = json_to_string v in + ("outputBase", if Int.of_string v >= 0 then v else "(" ^ v ^ ")") + | "inputBase", v -> + let v = json_to_string v in + ("inputBase", if Int.of_string v >= 0 then v else "(" ^ v ^ ")") + | "expected", v -> ("expected", optional_int_list v) + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit -let edit_allergies (ps: (string * json) list): (string * string) list = +let edit_allergies (ps : (string * json) list) : (string * string) list = let has_key key (k, _) = String.(k = key) in - let filtered = List.filter ps ~f:(fun p -> has_key "score" p || has_key "item" p) in + let filtered = + List.filter ps ~f:(fun p -> has_key "score" p || has_key "item" p) + in let by_key k = List.find filtered ~f:(has_key k) in - let params = ["score"; "item"] - |> List.filter_map ~f:by_key - |> List.filter_map ~f:(function - | ("score", `Int v) -> Some (Int.to_string v) - | ("item", `String i) -> Some (String.capitalize i) - | _ -> None) - |> String.concat ~sep:" " in + let params = + [ "score"; "item" ] |> List.filter_map ~f:by_key + |> List.filter_map ~f:(function + | "score", `Int v -> Some (Int.to_string v) + | "item", `String i -> Some (String.capitalize i) + | _ -> None) + |> String.concat ~sep:" " + in let edit = function - | ("item", _) -> None - | ("score", _) -> None - | ("expected", `List l) -> Some ("expected", List.map l ~f:(function `String s -> String.capitalize s | t -> json_to_string t) |> String.concat ~sep:"; " |> Printf.sprintf "[%s]") - | (k, v) -> Some (k, json_to_string v) in - ("params", params) :: (List.filter_map ps ~f:edit) + | "item", _ -> None + | "score", _ -> None + | "expected", `List l -> + Some + ( "expected", + List.map l ~f:(function + | `String s -> String.capitalize s + | t -> json_to_string t) + |> String.concat ~sep:"; " |> Printf.sprintf "[%s]" ) + | k, v -> Some (k, json_to_string v) + in + ("params", params) :: List.filter_map ps ~f:edit -let edit_connect (ps: (string * json) list): (string * string) list = +let edit_connect (ps : (string * json) list) : (string * string) list = let format_board l = if List.length l > 1 then - l |> List.map ~f:(json_to_string) - |> String.concat ~sep:";\n" + l |> List.map ~f:json_to_string |> String.concat ~sep:";\n" |> Printf.sprintf "[\n%s;\n]" else json_to_string (`List l) in let edit = function - | ("expected", `String "X") -> ("expected", "(Some X)") - | ("expected", `String "O") -> ("expected", "(Some O)") - | ("expected", `String "" ) -> ("expected", "None") - | ("board", `List l) -> ("board", format_board l) - | (k, v) -> (k, json_to_string v) in + | "expected", `String "X" -> ("expected", "(Some X)") + | "expected", `String "O" -> ("expected", "(Some O)") + | "expected", `String "" -> ("expected", "None") + | "board", `List l -> ("board", format_board l) + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit -let edit_dominoes (ps: (string * json) list): (string * string) list = - let edit (p: (string * json)) = match p with - | ("dominoes", `List j) -> ("dominoes", "[" ^ (List.map ~f:two_elt_list_to_tuple j |> String.concat ~sep:"; ") ^ "]") - | (k, v) -> (k, json_to_string v) in +let edit_dominoes (ps : (string * json) list) : (string * string) list = + let edit (p : string * json) = + match p with + | "dominoes", `List j -> + ( "dominoes", + "[" + ^ (List.map ~f:two_elt_list_to_tuple j |> String.concat ~sep:"; ") + ^ "]" ) + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit -let edit_minesweeper (ps: (string * json) list): (string * string) list = +let edit_minesweeper (ps : (string * json) list) : (string * string) list = let format_board l = if List.length l > 1 then - l |> List.map ~f:json_to_string |> String.concat ~sep:";\n" |> Printf.sprintf "[\n%s;\n]" - else - json_to_string (`List l) + l |> List.map ~f:json_to_string |> String.concat ~sep:";\n" + |> Printf.sprintf "[\n%s;\n]" + else json_to_string (`List l) in let edit = function - | ("minefield", `List l) -> ("minefield", format_board l) - | ("expected", `List l) -> ("expected", format_board l) - | (k, v) -> (k, json_to_string v) in + | "minefield", `List l -> ("minefield", format_board l) + | "expected", `List l -> ("expected", format_board l) + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit - let edit_space_age (ps: (string * json) list): (string * string) list = - let edit = function - | ("planet", v) -> - ("planet", json_to_string v |> strip_quotes) - | ("expected", v) -> - let wrapped = match v with - | `Float f -> Printf.sprintf "Ok %.2f" f - | `Int i -> Printf.sprintf "Ok %.2f" (Float.of_int i) - | `Assoc [("error", `String msg)] -> Printf.sprintf "Error %S" msg - | _ -> json_to_string v - in - ("expected", wrapped) - | (k, v) -> (k, json_to_string v) +let edit_space_age (ps : (string * json) list) : (string * string) list = + let edit = function + | "planet", v -> ("planet", json_to_string v |> strip_quotes) + | "expected", v -> + let wrapped = + match v with + | `Float f -> Printf.sprintf "Ok %.2f" f + | `Int i -> Printf.sprintf "Ok %.2f" (Float.of_int i) + | `Assoc [ ("error", `String msg) ] -> Printf.sprintf "Error %S" msg + | _ -> json_to_string v + in + ("expected", wrapped) + | k, v -> (k, json_to_string v) in List.map ps ~f:edit -let null_to_option = function `Null -> "None" | x -> Printf.sprintf "(Some %s)" (json_to_string x) +let null_to_option = function + | `Null -> "None" + | x -> Printf.sprintf "(Some %s)" (json_to_string x) -let edit_palindrome_products (ps: (string * json) list): (string * string) list = +let edit_palindrome_products (ps : (string * json) list) : + (string * string) list = let edit = function - | ("property", v) -> ("property", json_to_string v |> strip_quotes) - | ("expected", `Assoc kvs) -> - let find = List.Assoc.find kvs ~equal:String.equal in - let open Option.Monad_infix in - let success_result = - find "value" >>= fun value -> - find "factors" >>= fun factors -> - let factors = to_list factors in - let factors_str = "[" ^ (List.map ~f:two_elt_list_to_tuple factors |> String.concat ~sep:"; ") ^ "]" in - let expected = Printf.sprintf "Ok {value=%s; factors=%s}" (null_to_option value) factors_str in - Some ("expected", expected) in - if Option.is_some success_result - then Option.value_exn success_result - else - let error = List.Assoc.find_exn kvs ~equal:String.equal "error" in - ("expected", "Error " ^ json_to_string error) - | (k, v) -> (k, json_to_string v) + | "property", v -> ("property", json_to_string v |> strip_quotes) + | "expected", `Assoc kvs -> + let find = List.Assoc.find kvs ~equal:String.equal in + let open Option.Monad_infix in + let success_result = + find "value" >>= fun value -> + find "factors" >>= fun factors -> + let factors = to_list factors in + let factors_str = + "[" + ^ (List.map ~f:two_elt_list_to_tuple factors + |> String.concat ~sep:"; ") + ^ "]" + in + let expected = + Printf.sprintf "Ok {value=%s; factors=%s}" (null_to_option value) + factors_str + in + Some ("expected", expected) + in + if Option.is_some success_result then Option.value_exn success_result + else + let error = List.Assoc.find_exn kvs ~equal:String.equal "error" in + ("expected", "Error " ^ json_to_string error) + | k, v -> (k, json_to_string v) in List.map ps ~f:edit -let edit_bowling (ps: (string * json) list): (string * string) list = +let edit_bowling (ps : (string * json) list) : (string * string) list = let edit = function - | ("property", v) -> ("property", json_to_string v |> strip_quotes) - | ("roll", `Int n) -> ("roll", let s = Int.to_string n in if n < 0 then ("(" ^ s ^ ")") else s) - | ("expected", v) -> ("expected", edit_bowling_expected v) - | (k, v) -> (k, json_to_string v) in - (List.map ps ~f:edit) @ if List.exists ps ~f:(fun (k, _) -> String.equal "roll" k) then [] else [("roll", "")] + | "property", v -> ("property", json_to_string v |> strip_quotes) + | "roll", `Int n -> + ( "roll", + let s = Int.to_string n in + if n < 0 then "(" ^ s ^ ")" else s ) + | "expected", v -> ("expected", edit_bowling_expected v) + | k, v -> (k, json_to_string v) + in + List.map ps ~f:edit + @ + if List.exists ps ~f:(fun (k, _) -> String.equal "roll" k) then [] + else [ ("roll", "") ] -let edit_binary_search (ps: (string * json) list): (string * string) list = +let edit_binary_search (ps : (string * json) list) : (string * string) list = let open Yojson.Basic.Util in let as_array_string xs = let xs = to_list xs |> List.map ~f:to_int |> List.map ~f:Int.to_string in - "[|" ^ String.concat ~sep:"; " xs ^ "|]" in + "[|" ^ String.concat ~sep:"; " xs ^ "|]" + in let edit = function - | ("array", v) -> ("array", as_array_string v) - | ("expected", `Int i) -> ("expected", Printf.sprintf "(Ok %i)" i) - | ("expected", `Assoc [("error", `String m)]) -> ("expected", Printf.sprintf "(Error \"%s\")" m) - | (k, v) -> (k, json_to_string v) in + | "array", v -> ("array", as_array_string v) + | "expected", `Int i -> ("expected", Printf.sprintf "(Ok %i)" i) + | "expected", `Assoc [ ("error", `String m) ] -> + ("expected", Printf.sprintf "(Error \"%s\")" m) + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit -let edit_change (ps: (string * json) list): (string * string) list = +let edit_change (ps : (string * json) list) : (string * string) list = let edit = function - | ("target", `Int i) -> ("target", Printf.sprintf (if i < 0 then "(%i)" else "%i") i) - | ("expected", v) -> ("expected", match v with - | `List xs -> "(Ok [" ^ (String.concat ~sep:"; " (List.map ~f:json_to_string xs)) ^ "])" - | `Assoc [("error", v)] -> "(Error " ^ json_to_string v ^ ")" - | x -> failwith "Bad json value in change " ^ json_to_string x) - | (k, v) -> (k, json_to_string v) in + | "target", `Int i -> + ("target", Printf.sprintf (if i < 0 then "(%i)" else "%i") i) + | "expected", v -> + ( "expected", + match v with + | `List xs -> + "(Ok [" + ^ String.concat ~sep:"; " (List.map ~f:json_to_string xs) + ^ "])" + | `Assoc [ ("error", v) ] -> "(Error " ^ json_to_string v ^ ")" + | x -> failwith "Bad json value in change " ^ json_to_string x ) + | k, v -> (k, json_to_string v) + in ps |> List.map ~f:edit -let edit_darts (ps: (string * json) list): (string * string) list = - let edit_float = function - | v -> match (String.contains v '.') with - | true -> v - | false -> v ^ ".0" in +let edit_darts (ps : (string * json) list) : (string * string) list = + let edit_float = function + | v -> ( match String.contains v '.' with true -> v | false -> v ^ ".0") + in let edit = function - | ("x", v) -> ("x", (edit_float (json_to_string v))) - | ("y", v) -> ("y", (edit_float (json_to_string v))) - | (k, v) -> (k, json_to_string v) in + | "x", v -> ("x", edit_float (json_to_string v)) + | "y", v -> ("y", edit_float (json_to_string v)) + | k, v -> (k, json_to_string v) + in ps |> List.map ~f:edit -let edit_rectangles (ps: (string * json) list): (string * string) list = +let edit_rectangles (ps : (string * json) list) : (string * string) list = let format_field l = let sep = if List.length l > 1 then ";\n" else "" in - let fmt = if List.length l > 1 then Printf.sprintf "[|\n%s;\n|]" else Printf.sprintf "[|%s|]" in - l |> List.map ~f:json_to_string - |> String.concat ~sep - |> fmt + let fmt = + if List.length l > 1 then Printf.sprintf "[|\n%s;\n|]" + else Printf.sprintf "[|%s|]" + in + l |> List.map ~f:json_to_string |> String.concat ~sep |> fmt in let edit = function - | ("strings", `List l) -> ("strings", format_field l) - | (k, v) -> (k, json_to_string v) in + | "strings", `List l -> ("strings", format_field l) + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit -let edit_etl (ps: (string * json) list): (string * string) list = +let edit_etl (ps : (string * json) list) : (string * string) list = let edit = function - | ("expected", `Assoc l) -> - let grouped = l - |> List.map ~f:(fun (k, v) -> Printf.sprintf "('%s', %s)" k (json_to_string v)) - |> List.groupi ~break:(fun i _ _ -> Int.(i % 5 = 0)) - in - if List.length grouped > 1 then - grouped - |> List.map ~f:(String.concat ~sep:"; ") - |> String.concat ~sep:";\n" - |> fun v -> ("expected", Printf.sprintf "[\n%s;\n]" v) - else - grouped - |> List.map ~f:(String.concat ~sep:"; ") - |> String.concat ~sep:"; " - |> fun v -> ("expected", Printf.sprintf "[%s]" v) - | (k, v) -> (k, json_to_string v) in + | "expected", `Assoc l -> + let grouped = + l + |> List.map ~f:(fun (k, v) -> + Printf.sprintf "('%s', %s)" k (json_to_string v)) + |> List.groupi ~break:(fun i _ _ -> Int.(i % 5 = 0)) + in + if List.length grouped > 1 then + grouped + |> List.map ~f:(String.concat ~sep:"; ") + |> String.concat ~sep:";\n" + |> fun v -> ("expected", Printf.sprintf "[\n%s;\n]" v) + else + grouped + |> List.map ~f:(String.concat ~sep:"; ") + |> String.concat ~sep:"; " + |> fun v -> ("expected", Printf.sprintf "[%s]" v) + | k, v -> (k, json_to_string v) + in let s = List.map ps ~f:edit in - s @ ( - ps - |> List.filter_map ~f:(fun (k, v) -> ( - if String.equal k "expected" then - None - else - match v with - | `List l -> + s + @ ( ps + |> List.filter_map ~f:(fun (k, v) -> + if String.equal k "expected" then None + else + match v with + | `List l -> l |> List.filter_map ~f:(function - | `String s -> Some (Printf.sprintf "'%s'" s) - | _ -> None) + | `String s -> Some (Printf.sprintf "'%s'" s) + | _ -> None) |> String.concat ~sep:"; " - |> fun s -> (k, Printf.sprintf "[%s]" s) - |> Option.return - | _ -> None - )) - |> (fun l -> - if List.length l <= 2 then - [("input", "[" ^ (List.map l ~f:(fun (k, v) -> Printf.sprintf "(%s, %s)" k v) |> (String.concat ~sep:"; ")) ^ "]")] - else - [("input", "[\n" ^ (List.map l ~f:(fun (k, v) -> Printf.sprintf "(%s, %s)" k v) |> (String.concat ~sep:";\n")) ^ ";\n]")] - )) - -let rec edit_expected ~(f: json -> string) (parameters: (string * json) list) = match parameters with + |> fun s -> (k, Printf.sprintf "[%s]" s) |> Option.return + | _ -> None) + |> fun l -> + if List.length l <= 2 then + [ + ( "input", + "[" + ^ (List.map l ~f:(fun (k, v) -> Printf.sprintf "(%s, %s)" k v) + |> String.concat ~sep:"; ") + ^ "]" ); + ] + else + [ + ( "input", + "[\n" + ^ (List.map l ~f:(fun (k, v) -> Printf.sprintf "(%s, %s)" k v) + |> String.concat ~sep:";\n") + ^ ";\n]" ); + ] ) + +let rec edit_expected ~(f : json -> string) (parameters : (string * json) list) + = + match parameters with | [] -> [] | ("expected", v) :: rest -> ("expected", f v) :: edit_expected ~f rest | (k, v) :: rest -> (k, json_to_string v) :: edit_expected ~f rest -let edit_knapsack (ps: (string * json) list): (string * string) list = - let item (i: json) : (string) = +let edit_knapsack (ps : (string * json) list) : (string * string) list = + let item (i : json) : string = match i with - | `Assoc l -> - "{" ^ (List.map l ~f:(fun (k, v) -> Printf.sprintf "%s = %s" k (json_to_string v)) |> (String.concat ~sep:"; ")) ^ "}" - | other -> json_to_string other in - let spacer (v: 'a list): (string) = - match v with - | _i1 :: _i2 :: _rest -> "\n" - | _ -> "" in - let items_list (v: json): string = + | `Assoc l -> + "{" + ^ (List.map l ~f:(fun (k, v) -> + Printf.sprintf "%s = %s" k (json_to_string v)) + |> String.concat ~sep:"; ") + ^ "}" + | other -> json_to_string other + in + let spacer (v : 'a list) : string = + match v with _i1 :: _i2 :: _rest -> "\n" | _ -> "" + in + let items_list (v : json) : string = match v with - | `List l -> + | `List l -> let s = spacer l in s ^ "[" ^ (List.map l ~f:item |> String.concat ~sep:";\n") ^ "]" ^ s - | _ -> json_to_string v + | _ -> json_to_string v in let edit = function - | ("items", v) -> ("items", items_list v) - | (k, v) -> (k, json_to_string v) in + | "items", v -> ("items", items_list v) + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit let edit_collatz_conjecture_expected = function | `Int n -> "(Ok " ^ Int.to_string n ^ ")" - | `Assoc [("error", `String m)] -> "(Error \"" ^ m ^ "\")" + | `Assoc [ ("error", `String m) ] -> "(Error \"" ^ m ^ "\")" | x -> Yojson.Basic.to_string x -let edit_perfect_numbers (ps: (string * json) list): (string * string) list = +let edit_perfect_numbers (ps : (string * json) list) : (string * string) list = let edit = function - | ("expected", `Assoc [("error", v)]) -> ("expected", "(Error " ^ json_to_string v ^ ")") - | ("expected", `String s) -> ("expected", "(Ok \"" ^ s ^ "\")") - | (k, v) -> (k, json_to_string v) in + | "expected", `Assoc [ ("error", v) ] -> + ("expected", "(Error " ^ json_to_string v ^ ")") + | "expected", `String s -> ("expected", "(Ok \"" ^ s ^ "\")") + | k, v -> (k, json_to_string v) + in List.map ps ~f:edit let edit_nth_prime_expected = function | `Int n -> "(Ok " ^ Int.to_string n ^ ")" - | `Assoc [("error", `String m)] -> "(Error \"" ^ m ^ "\")" + | `Assoc [ ("error", `String m) ] -> "(Error \"" ^ m ^ "\")" | x -> Yojson.Basic.to_string x - -let unwrap_strings (ps: (string * json) list): (string * string) list option = + +let unwrap_strings (ps : (string * json) list) : (string * string) list option = let edit = function - | (_, `String s) -> ("params", s) - | (k, v) -> (k, json_to_string v) in + | _, `String s -> ("params", s) + | k, v -> (k, json_to_string v) + in ps |> List.map ~f:edit |> Option.return let edit_two_fer ps = let edit (k, v) = match (k, v) with - | ("name", `Null) -> ("name", "None") - | ("name", `String s) -> ("name", "(Some \"" ^ s ^ "\")") - | (k, v) -> (k, json_to_string v) + | "name", `Null -> ("name", "None") + | "name", `String s -> ("name", "(Some \"" ^ s ^ "\")") + | k, v -> (k, json_to_string v) in List.map ps ~f:edit -let edit_parameters ~(slug: string) (parameters: (string * json) list) = match (slug, parameters) with - | ("all-your-base", ps) -> edit_all_your_base ps |> Option.return - | ("allergies", ps) -> edit_allergies ps |> Option.return - | ("beer-song", ps) -> edit_expected ~f:edit_beer_song_expected ps |> Option.return - | ("binary-search", ps) -> edit_binary_search ps |> Option.return - | ("bowling", ps) -> edit_bowling ps |> Option.return - | ("collatz-conjecture", ps) -> edit_expected ~f:edit_collatz_conjecture_expected ps |> Option.return - | ("connect", ps) -> edit_connect ps |> Option.return - | ("change", ps) -> edit_change ps |> Option.return - | ("darts", ps) -> edit_darts ps |> Option.return - | ("dominoes", ps) -> edit_dominoes ps |> Option.return - | ("etl", ps) -> edit_etl ps |> Option.return - | ("forth", ps) -> edit_expected ~f:edit_forth_expected ps |> Option.return - | ("hamming", ps) -> edit_expected ~f:edit_hamming_expected ps |> Option.return - | ("knapsack", ps) -> edit_knapsack ps |> Option.return - | ("minesweeper", ps) -> edit_minesweeper ps |> Option.return - | ("nth-prime", ps) -> edit_expected ~f:edit_nth_prime_expected ps |> Option.return - | ("palindrome-products", ps) -> edit_palindrome_products ps |> Option.return - | ("perfect-numbers", ps) -> edit_perfect_numbers ps |> Option.return - | ("phone-number", ps) -> edit_expected ~f:edit_phone_number_expected ps |> Option.return - | ("rectangles", ps) -> edit_rectangles ps |> Option.return - | ("say", ps) -> edit_say ps |> Option.return - | ("space-age", ps) -> edit_space_age ps |> Option.return - | ("triangle", ps) -> edit_triangle ps - | ("two-fer", ps) -> edit_two_fer ps |> Option.return - | ("custom-set", ps) -> unwrap_strings ps - | ("grade-school", ps) -> unwrap_strings ps - | (_, ps) -> map_elements json_to_string ps |> Option.return - -let edit_difference_of_squares_case (case: json): json = +let edit_parameters ~(slug : string) (parameters : (string * json) list) = + match (slug, parameters) with + | "all-your-base", ps -> edit_all_your_base ps |> Option.return + | "allergies", ps -> edit_allergies ps |> Option.return + | "beer-song", ps -> + edit_expected ~f:edit_beer_song_expected ps |> Option.return + | "binary-search", ps -> edit_binary_search ps |> Option.return + | "bowling", ps -> edit_bowling ps |> Option.return + | "collatz-conjecture", ps -> + edit_expected ~f:edit_collatz_conjecture_expected ps |> Option.return + | "connect", ps -> edit_connect ps |> Option.return + | "change", ps -> edit_change ps |> Option.return + | "darts", ps -> edit_darts ps |> Option.return + | "dominoes", ps -> edit_dominoes ps |> Option.return + | "etl", ps -> edit_etl ps |> Option.return + | "forth", ps -> edit_expected ~f:edit_forth_expected ps |> Option.return + | "hamming", ps -> edit_expected ~f:edit_hamming_expected ps |> Option.return + | "knapsack", ps -> edit_knapsack ps |> Option.return + | "minesweeper", ps -> edit_minesweeper ps |> Option.return + | "nth-prime", ps -> + edit_expected ~f:edit_nth_prime_expected ps |> Option.return + | "palindrome-products", ps -> edit_palindrome_products ps |> Option.return + | "perfect-numbers", ps -> edit_perfect_numbers ps |> Option.return + | "phone-number", ps -> + edit_expected ~f:edit_phone_number_expected ps |> Option.return + | "rectangles", ps -> edit_rectangles ps |> Option.return + | "say", ps -> edit_say ps |> Option.return + | "space-age", ps -> edit_space_age ps |> Option.return + | "triangle", ps -> edit_triangle ps + | "two-fer", ps -> edit_two_fer ps |> Option.return + | "custom-set", ps -> unwrap_strings ps + | "grade-school", ps -> unwrap_strings ps + | _, ps -> map_elements json_to_string ps |> Option.return + +let edit_difference_of_squares_case (case : json) : json = let f = function - | ("property", `String "squareOfSum") -> ("property", `String "square_of_sum") - | ("property", `String "sumOfSquares") -> ("property", `String "sum_of_squares") - | ("property", `String "differenceOfSquares") -> ("property", `String "difference_of_squares") - | ("slug", `String "square_the_sum_of_the_numbers_up_to_the_given_number") -> ("slug", `String "square_of_sum") - | ("slug", `String "sum_the_squares_of_the_numbers_up_to_the_given_number") -> ("slug", `String "sum_of_squares") - | ("slug", `String "subtract_sum_of_squares_from_square_of_sums") -> ("slug", `String "difference_of_squares") + | "property", `String "squareOfSum" -> ("property", `String "square_of_sum") + | "property", `String "sumOfSquares" -> + ("property", `String "sum_of_squares") + | "property", `String "differenceOfSquares" -> + ("property", `String "difference_of_squares") + | "slug", `String "square_the_sum_of_the_numbers_up_to_the_given_number" -> + ("slug", `String "square_of_sum") + | "slug", `String "sum_the_squares_of_the_numbers_up_to_the_given_number" -> + ("slug", `String "sum_of_squares") + | "slug", `String "subtract_sum_of_squares_from_square_of_sums" -> + ("slug", `String "difference_of_squares") | p -> p in `Assoc (case |> Util.to_assoc |> List.map ~f) -let edit_run_length_encoding_case (case: json): json = +let edit_run_length_encoding_case (case : json) : json = let f = function - | ("property", `String "consistency") -> ("property", `String "encode |> decode") - | ("slug", `String "run_length_encode_a_string") -> ("slug", `String "encode") - | ("slug", `String "run_length_decode_a_string") -> ("slug", `String "decode") + | "property", `String "consistency" -> + ("property", `String "encode |> decode") + | "slug", `String "run_length_encode_a_string" -> ("slug", `String "encode") + | "slug", `String "run_length_decode_a_string" -> ("slug", `String "decode") | p -> p in `Assoc (case |> Util.to_assoc |> List.map ~f) -let edit_allergies_case (case: json): json = +let edit_allergies_case (case : json) : json = let f = function - | ("property", `String "allergicTo") -> [("property", `String "allergic_to"); ("assertion", `String "aeb")] - | ("property", `String "list") -> [("property", `String "allergies"); ("assertion", `String "aea")] - | p -> [p] + | "property", `String "allergicTo" -> + [ ("property", `String "allergic_to"); ("assertion", `String "aeb") ] + | "property", `String "list" -> + [ ("property", `String "allergies"); ("assertion", `String "aea") ] + | p -> [ p ] in `Assoc (case |> Util.to_assoc |> List.concat_map ~f) -let edit_custom_set_case (case: json): json = - let get_input ~key = Util.member "input" case - |> Util.member key +let edit_custom_set_case (case : json) : json = + let get_input ~key = Util.member "input" case |> Util.member key in + let get_list ~key = + get_input ~key + |> ( function `List l -> l | _ -> [] ) + |> List.map ~f:Util.to_int |> List.map ~f:Int.to_string |> list_to_string in - let get_list ~key = get_input ~key - |> (function `List l -> l | _ -> []) - |> List.map ~f:Util.to_int - |> List.map ~f:Int.to_string - |> list_to_string in let module_name = ("module_name", `String "CSet") in let extend l = Util.combine (`Assoc (module_name :: l)) case in - let binary_set a b = `String (Printf.sprintf "(CSet.of_list [%s]) (CSet.of_list [%s])" (get_list ~key:a) (get_list ~key:b)) in - let binary_set_el a el = `String (Printf.sprintf "(CSet.of_list [%s]) %i" (get_list ~key:a) (get_input ~key:el |> Util.to_int)) in + let binary_set a b = + `String + (Printf.sprintf "(CSet.of_list [%s]) (CSet.of_list [%s])" + (get_list ~key:a) (get_list ~key:b)) + in + let binary_set_el a el = + `String + (Printf.sprintf "(CSet.of_list [%s]) %i" (get_list ~key:a) + (get_input ~key:el |> Util.to_int)) + in match Util.member "property" case with - | `String "empty" -> extend [ - ("assertion", `String "ae"); - ("property", `String "is_empty"); - ("input", `Assoc [ - ("params", `String (Printf.sprintf "(CSet.of_list [%s])" (get_list ~key:"set"))); - ]) - ] - | `String "contains" -> extend [ - ("assertion", `String "ae"); - ("property", `String "is_member"); - ("input", `Assoc [ - ("params", binary_set_el "set" "element"); - ]) - ] - | `String "subset" -> extend [ - ("assertion", `String "ae"); - ("property", `String "is_subset"); - ("input", `Assoc [ - ("params", binary_set "set1" "set2"); - ]) - ] - | `String "disjoint" -> extend [ - ("assertion", `String "ae"); - ("property", `String "is_disjoint"); - ("input", `Assoc [ - ("params", binary_set "set1" "set2"); - ]); - ] - | `String "equal" -> extend [ - ("assertion", `String "ae"); - ("property", `String "equal"); - ("input", `Assoc [ - ("params", binary_set "set1" "set2"); - ]) - ] - | `String "add" -> extend [ - ("assertion", `String "aec"); - ("input", `Assoc [ - ("params", binary_set_el "set" "element"); - ]) - ] - | `String "intersection" -> extend [ - ("assertion", `String "aec"); - ("property", `String "intersect"); - ("input", `Assoc [ - ("params", binary_set "set1" "set2"); - ]) - ] - | `String "difference" | `String "union" -> extend [ - ("assertion", `String "aec"); - ("input", `Assoc [ - ("params", binary_set "set1" "set2"); - ]) - ] - | `String prop -> extend [ - ("assertion", `String "ae"); - ("property", `String prop); - ("input", `Assoc [ - ("params", `String (Util.member "input" case |> json_to_string)); - ]) - ] + | `String "empty" -> + extend + [ + ("assertion", `String "ae"); + ("property", `String "is_empty"); + ( "input", + `Assoc + [ + ( "params", + `String + (Printf.sprintf "(CSet.of_list [%s])" (get_list ~key:"set")) + ); + ] ); + ] + | `String "contains" -> + extend + [ + ("assertion", `String "ae"); + ("property", `String "is_member"); + ("input", `Assoc [ ("params", binary_set_el "set" "element") ]); + ] + | `String "subset" -> + extend + [ + ("assertion", `String "ae"); + ("property", `String "is_subset"); + ("input", `Assoc [ ("params", binary_set "set1" "set2") ]); + ] + | `String "disjoint" -> + extend + [ + ("assertion", `String "ae"); + ("property", `String "is_disjoint"); + ("input", `Assoc [ ("params", binary_set "set1" "set2") ]); + ] + | `String "equal" -> + extend + [ + ("assertion", `String "ae"); + ("property", `String "equal"); + ("input", `Assoc [ ("params", binary_set "set1" "set2") ]); + ] + | `String "add" -> + extend + [ + ("assertion", `String "aec"); + ("input", `Assoc [ ("params", binary_set_el "set" "element") ]); + ] + | `String "intersection" -> + extend + [ + ("assertion", `String "aec"); + ("property", `String "intersect"); + ("input", `Assoc [ ("params", binary_set "set1" "set2") ]); + ] + | `String "difference" | `String "union" -> + extend + [ + ("assertion", `String "aec"); + ("input", `Assoc [ ("params", binary_set "set1" "set2") ]); + ] + | `String prop -> + extend + [ + ("assertion", `String "ae"); + ("property", `String prop); + ( "input", + `Assoc + [ + ("params", `String (Util.member "input" case |> json_to_string)); + ] ); + ] | _ -> case -let edit_grade_school_case (case: json): json = - let string_of_students () = Util.member "input" case - |> Util.member "students" - |> Util.to_list +let edit_grade_school_case (case : json) : json = + let string_of_students () = + Util.member "input" case |> Util.member "students" |> Util.to_list |> List.filter_map ~f:(fun student -> - match student with - | `List ((`String name)::(`Int grade)::_) -> Some (Printf.sprintf "add \"%s\" %i" name grade) - | _ -> None - ) - |> fun l -> match l with - | [] -> "" - | _::_ when List.length l <= 3 -> Printf.sprintf " |> %s" (String.concat l ~sep:" |> ") - | _::_ -> Printf.sprintf "\n|> %s" (String.concat l ~sep:"\n|> ") in + match student with + | `List (`String name :: `Int grade :: _) -> + Some (Printf.sprintf "add \"%s\" %i" name grade) + | _ -> None) + |> fun l -> + match l with + | [] -> "" + | _ :: _ when List.length l <= 3 -> + Printf.sprintf " |> %s" (String.concat l ~sep:" |> ") + | _ :: _ -> Printf.sprintf "\n|> %s" (String.concat l ~sep:"\n|> ") + in let input = Util.member "input" case in - Util.combine (`Assoc [ - ("setup", `String (string_of_students ())); - ("input", Util.combine (`Assoc [ - ("params", match Util.member "desiredGrade" input |> Util.to_int_option with Some grade -> `String (Int.to_string grade) | None -> `String "") - ]) input) - ]) case + Util.combine + (`Assoc + [ + ("setup", `String (string_of_students ())); + ( "input", + Util.combine + (`Assoc + [ + ( "params", + match + Util.member "desiredGrade" input |> Util.to_int_option + with + | Some grade -> `String (Int.to_string grade) + | None -> `String "" ); + ]) + input ); + ]) + case let edit_etl_case (case : Yojson.Basic.t) : Yojson.Basic.t = let legacy_contents = - case - |> Util.member "input" - |> Util.member "legacy" - |> Util.to_assoc + case |> Util.member "input" |> Util.member "legacy" |> Util.to_assoc |> fun l -> `Assoc l in let updated_case = - case - |> Util.to_assoc + case |> Util.to_assoc |> List.map ~f:(fun (k, v) -> - if String.(k = "input") then (k, legacy_contents) else (k, v) - ) + if String.(k = "input") then (k, legacy_contents) else (k, v)) |> fun l -> `Assoc l in updated_case - -let edit_case ~(slug: string) (case: json) = +let edit_case ~(slug : string) (case : json) = match (slug, case) with - | ("allergies", case) -> edit_allergies_case case - | ("custom-set", case) -> edit_custom_set_case case - | ("etl", case) -> edit_etl_case case - | ("grade-school", case) -> edit_grade_school_case case - | ("difference-of-squares", case) -> edit_difference_of_squares_case case - | ("run-length-encoding", case) -> edit_run_length_encoding_case case - | (_, case) -> case + | "allergies", case -> edit_allergies_case case + | "custom-set", case -> edit_custom_set_case case + | "etl", case -> edit_etl_case case + | "grade-school", case -> edit_grade_school_case case + | "difference-of-squares", case -> edit_difference_of_squares_case case + | "run-length-encoding", case -> edit_run_length_encoding_case case + | _, case -> case diff --git a/test-generator/lib_generator/template.ml b/test-generator/lib_generator/template.ml index c280e9a970..8c537bb876 100644 --- a/test-generator/lib_generator/template.ml +++ b/test-generator/lib_generator/template.ml @@ -1,30 +1,26 @@ open Core -type t = { - path: string; - relative_path: string; - content: string; -} +type t = { path : string; relative_path : string; content : string } -let of_path (path: string) ~(tpl: string): t = +let of_path (path : string) ~(tpl : string) : t = let content = Files.read_file path |> Result.ok_exn in let relative_path = Files.relative_path tpl path in - { - path; - relative_path; - content - } + { path; relative_path; content } -let format (c: string): string = +let format (c : string) : string = let b = Buffer.create (String.length c) in - let o = { IndentPrinter.std_output with kind=(Print (fun s () -> Buffer.add_string b s)) } in + let o = + { + IndentPrinter.std_output with + kind = Print (fun s () -> Buffer.add_string b s); + } + in IndentPrinter.proceed o (Nstream.of_string c) IndentBlock.empty (); - (Buffer.contents b - |> String.split_lines - |> List.map ~f:String.rstrip - |> String.concat ~sep:"\n") ^ "\n" + (Buffer.contents b |> String.split_lines |> List.map ~f:String.rstrip + |> String.concat ~sep:"\n") + ^ "\n" -let render (t: t) ~(data: Canonical_data.t): string = +let render (t : t) ~(data : Canonical_data.t) : string = try Mustache.render (Mustache.of_string t.content) (Canonical_data.to_json data) |> String.substr_replace_all ~pattern:""" ~with_:"\"" @@ -33,11 +29,9 @@ let render (t: t) ~(data: Canonical_data.t): string = |> String.substr_replace_all ~pattern:"<" ~with_:"<" |> String.substr_replace_all ~pattern:">" ~with_:">" with exn -> - Printf.printf "%s\n======\n%s" (t.relative_path) (t.content); + Printf.printf "%s\n======\n%s" t.relative_path t.content; raise exn -let to_string (t: t): string = +let to_string (t : t) : string = Printf.sprintf "Template { path = %s; relative_path = %s; content = %s }" - t.path - t.relative_path - t.content + t.path t.relative_path t.content diff --git a/test-generator/test/all_tests.ml b/test-generator/test/all_tests.ml index 61e84da011..aaf3d46413 100644 --- a/test-generator/test/all_tests.ml +++ b/test-generator/test/all_tests.ml @@ -4,7 +4,9 @@ open Model_test open Special_cases_test let () = - run_test_tt_main ("tests" >::: [ - "model_tests" >::: model_tests; - "special_cases_test" >::: special_cases_test; - ]) + run_test_tt_main + ("tests" + >::: [ + "model_tests" >::: model_tests; + "special_cases_test" >::: special_cases_test; + ]) diff --git a/test-generator/test/dune b/test-generator/test/dune index 1e2c532ddb..2540e66a1d 100644 --- a/test-generator/test/dune +++ b/test-generator/test/dune @@ -1,11 +1,14 @@ (dirs fixtures) + (data_only_dirs fixtures) (test (name all_tests) (libraries core ounit2 yojson generator) - (deps (glob_files fixtures/*))) + (deps + (glob_files fixtures/*))) (env - (dev - (flags (:standard -warn-error -A)))) + (dev + (flags + (:standard -warn-error -A)))) diff --git a/test-generator/test/model_test.ml b/test-generator/test/model_test.ml index acf067a553..ad91cb347b 100644 --- a/test-generator/test/model_test.ml +++ b/test-generator/test/model_test.ml @@ -4,7 +4,9 @@ open Generator.Model let ae exp got _ctxt = assert_equal ~printer:Fn.id exp got -let model_tests = [ - "json_to_string on list of strings" >:: - ae "[\"a\"; \"b\"; \"c\"]" @@ json_to_string (`List [`String "a"; `String "b"; `String "c"]); -] +let model_tests = + [ + "json_to_string on list of strings" + >:: ae "[\"a\"; \"b\"; \"c\"]" + @@ json_to_string (`List [ `String "a"; `String "b"; `String "c" ]); + ] diff --git a/test-generator/test/special_cases_test.ml b/test-generator/test/special_cases_test.ml index de11997f67..c2ad85691d 100644 --- a/test-generator/test/special_cases_test.ml +++ b/test-generator/test/special_cases_test.ml @@ -5,44 +5,42 @@ open Generator.Special_cases let ae exp got _ctxt = assert_equal ~printer:Fn.id exp got let tuples_printer kvs = - String.concat ~sep:";" @@ List.map ~f:(fun (k,v) -> "(" ^ k ^ "," ^ v ^ ")") kvs + String.concat ~sep:";" + @@ List.map ~f:(fun (k, v) -> "(" ^ k ^ "," ^ v ^ ")") kvs let stringify = function | `Bool true -> "stringified" | _ -> failwith "Bad type for stringify" -let special_cases_test = [ - "an optional int parameter is converted to none if it matches the special value" >:: (fun _ctx -> - assert_equal "None" @@ optional_int ~none:88 (`Int 88) - ); - - "an optional int parameter is converted to (Some value) if it does not match the special value" >:: (fun _ctx -> - assert_equal "(Some 0)" @@ optional_int ~none:88 (`Int 0) - ); - - "default_value does not provide a default for a list that has the given key already" >:: (fun _ctx -> - let ps = [("key", "value")] in - assert_equal ps @@ default_value ~key:"key" ~value:"value2" ps - ); - - "default_value does provides a default for a list that does not have the given key" >:: (fun _ctx -> - assert_equal [("key", "value")] @@ default_value ~key:"key" ~value:"value" [] - ); - - "optional_strings replace value with Some(value)" >:: (fun _ctx -> - assert_equal ~printer:tuples_printer [("key", "(Some \"value\")"); ("key2", "\"value2\"")] - @@ optional_strings ~f:(fun x -> String.(x = "key")) [("key", `String "value"); ("key2", `String "value2")] - ); - - "option_of_null converts Null to None" >:: (fun _ctx -> - assert_equal "None" @@ option_of_null `Null - ); - - "option_of_null converts String to Some" >:: (fun _ctx -> - assert_equal "(Some \"abc\")" @@ option_of_null (`String "abc") - ); - - "option_of_null converts List to Some" >:: (fun _ctx -> - assert_equal "(Some [1; 2; 3])" @@ option_of_null (`List [`Int 1;`Int 2;`Int 3]) - ); -] +let special_cases_test = + [ + ( "an optional int parameter is converted to none if it matches the \ + special value" + >:: fun _ctx -> assert_equal "None" @@ optional_int ~none:88 (`Int 88) ); + ( "an optional int parameter is converted to (Some value) if it does not \ + match the special value" + >:: fun _ctx -> assert_equal "(Some 0)" @@ optional_int ~none:88 (`Int 0) ); + ( "default_value does not provide a default for a list that has the given \ + key already" + >:: fun _ctx -> + let ps = [ ("key", "value") ] in + assert_equal ps @@ default_value ~key:"key" ~value:"value2" ps ); + ( "default_value does provides a default for a list that does not have the \ + given key" + >:: fun _ctx -> + assert_equal [ ("key", "value") ] + @@ default_value ~key:"key" ~value:"value" [] ); + ( "optional_strings replace value with Some(value)" >:: fun _ctx -> + assert_equal ~printer:tuples_printer + [ ("key", "(Some \"value\")"); ("key2", "\"value2\"") ] + @@ optional_strings + ~f:(fun x -> String.(x = "key")) + [ ("key", `String "value"); ("key2", `String "value2") ] ); + ( "option_of_null converts Null to None" >:: fun _ctx -> + assert_equal "None" @@ option_of_null `Null ); + ( "option_of_null converts String to Some" >:: fun _ctx -> + assert_equal "(Some \"abc\")" @@ option_of_null (`String "abc") ); + ( "option_of_null converts List to Some" >:: fun _ctx -> + assert_equal "(Some [1; 2; 3])" + @@ option_of_null (`List [ `Int 1; `Int 2; `Int 3 ]) ); + ] From 9159044574ff20f449e0db7d881699ad25c15cb8 Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 24 Mar 2026 13:14:22 +0100 Subject: [PATCH 09/14] update CI workflow to check linting before building dockerfile --- .github/workflows/ci.yml | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 4c38ec1e3f..54036c69f1 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -7,6 +7,23 @@ on: workflow_dispatch: jobs: + lint: + runs-on: ubuntu-24.04 + + steps: + - uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd + + - name: Set up OCaml + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: 5.4 + + - name: Install dependencies + run: opam install ocamlformat dune + + - name: Check formatting + run: opam exec -- dune build @fmt --root test-generator + ci: runs-on: ubuntu-24.04 From 70089767ba2f89760f90ea012930547223903da8 Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 24 Mar 2026 13:19:00 +0100 Subject: [PATCH 10/14] install specific version of ocamlformat --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 54036c69f1..7ac58bbd5e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -19,7 +19,7 @@ jobs: ocaml-compiler: 5.4 - name: Install dependencies - run: opam install ocamlformat dune + run: opam install ocamlformat.0.28.1 dune - name: Check formatting run: opam exec -- dune build @fmt --root test-generator From 81ed2a99add337b2727ca98548da4d0a6472d3f1 Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 24 Mar 2026 13:26:48 +0100 Subject: [PATCH 11/14] pin setup-ocaml version --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7ac58bbd5e..16a0d01034 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -14,7 +14,7 @@ jobs: - uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd - name: Set up OCaml - uses: ocaml/setup-ocaml@v3 + uses: ocaml/setup-ocaml@44184b0d1ab751e3d1726b13e0afef61d6980755 with: ocaml-compiler: 5.4 From ce3c19c7a107515fd45a2284d335bc2ff96c877f Mon Sep 17 00:00:00 2001 From: Owen Date: Tue, 24 Mar 2026 13:38:58 +0100 Subject: [PATCH 12/14] run ci after lint --- .github/workflows/ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 16a0d01034..6baaf983ca 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -25,6 +25,7 @@ jobs: run: opam exec -- dune build @fmt --root test-generator ci: + needs: lint runs-on: ubuntu-24.04 steps: From bb920710dcde7682d9e9973e54aa060f1ee09912 Mon Sep 17 00:00:00 2001 From: Owen Date: Fri, 27 Mar 2026 09:32:51 +0100 Subject: [PATCH 13/14] add built in dune-cache flag for caching ocam setup in lint job --- .github/workflows/ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6baaf983ca..4aab54324e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -17,6 +17,7 @@ jobs: uses: ocaml/setup-ocaml@44184b0d1ab751e3d1726b13e0afef61d6980755 with: ocaml-compiler: 5.4 + dune-cache: true - name: Install dependencies run: opam install ocamlformat.0.28.1 dune From df5d8e41a0c7adc26a52f04debd120826ffe7ad1 Mon Sep 17 00:00:00 2001 From: Owen Date: Fri, 27 Mar 2026 10:04:21 +0100 Subject: [PATCH 14/14] add small comment to retrigger cache test --- Makefile | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile b/Makefile index 6bdc84d955..8959e95b0f 100644 --- a/Makefile +++ b/Makefile @@ -55,6 +55,7 @@ $(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