Merge pull request #418 from Leonidas-from-XIV/parse-env-once

Parse env only once

Author: Leonidas-from-XIV

bin/cli.ml

@@ -68,20 +68,23 @@ let verbose_findlib =
 
 let prelude =
   let parse s =
-    let _, file = Mdx.Prelude.env_and_file s in
-    let parse, _ = Arg.non_dir_file in
-    match parse file with `Ok _ -> `Ok s | `Error e -> `Error e
+    let env, filename = Mdx.Prelude.env_and_payload s in
+    let parse, _pp = Arg.non_dir_file in
+    match parse filename with
+    | `Ok _ -> `Ok (env, filename)
+    | `Error _ as e -> e
   in
-  let prelude = (parse, Fmt.string) in
+  let prelude = (parse, Mdx.Prelude.pp) in
   let doc =
     "A file to load as prelude. Can be prefixed with $(i,env:) to specify a \
      specific environment to load the prelude in. Multiple prelude files can \
-     be provided:they will be evaluated in the order they are provided on the \
+     be provided: they will be evaluated in the order they are provided on the \
      command-line."
   in
   named
     (fun x -> `Prelude x)
-    Arg.(value & opt_all prelude [] & info [ "prelude" ] ~doc ~docv:"FILE")
+    Arg.(
+      value & opt_all prelude [] & info [ "prelude" ] ~doc ~docv:"[ENV:]FILE")
 
 let prelude_str =
   let doc =
@@ -90,9 +93,12 @@ let prelude_str =
      not contain any spaces. Multiple prelude strings can be provided: they \
      will be evaluated in the order they are provided on the command-line."
   in
+  let parse s = `Ok (Mdx.Prelude.env_and_payload s) in
+  let prelude = (parse, Mdx.Prelude.pp) in
   named
     (fun x -> `Prelude_str x)
-    Arg.(value & opt_all string [] & info [ "prelude-str" ] ~doc ~docv:"STR")
+    Arg.(
+      value & opt_all prelude [] & info [ "prelude-str" ] ~doc ~docv:"[ENV:]STR")
 
 let directories =
   let doc = "A list of directories to load for the #directory directive." in

bin/cli.mli

@@ -9,8 +9,8 @@ val silent_eval : [> `Silent_eval of bool ] t
 val record_backtrace : [> `Record_backtrace of bool ] t
 val silent : [> `Silent of bool ] t
 val verbose_findlib : [> `Verbose_findlib of bool ] t
-val prelude : [> `Prelude of string list ] t
-val prelude_str : [> `Prelude_str of string list ] t
+val prelude : [> `Prelude of Mdx.Prelude.t list ] t
+val prelude_str : [> `Prelude_str of Mdx.Prelude.t list ] t
 val directories : [> `Directories of string list ] t
 val root : [> `Root of string option ] t
 val force_output : [> `Force_output of bool ] t

bin/dune_gen.ml

@@ -16,11 +16,31 @@
 
 let run (`Setup ()) (`Prelude prelude) (`Directories dirs) =
   let buffer = Buffer.create 1024 in
-  let line fmt = Printf.bprintf buffer (fmt ^^ "\n") in
-  let list l =
-    Printf.sprintf "[%s]\n"
-      (String.concat ";" (List.map (Printf.sprintf "%S") l))
+  let ppf = Format.formatter_of_buffer buffer in
+  let line fmt = Fmt.kpf (fun ppf -> Fmt.string ppf "\n") ppf fmt in
+  let pp_list ppf =
+    Fmt.pf ppf "[%a]\n" (Fmt.list ~sep:(Fmt.any "; ") Fmt.Dump.string)
   in
+
+  let pp_ocaml_env ppf = function
+    | Mdx.Ocaml_env.Default -> Fmt.string ppf "Mdx.Ocaml_env.Default"
+    | Mdx.Ocaml_env.User_defined s ->
+        Fmt.pf ppf "(Mdx.Ocaml_env.User_defined %S)" s
+  in
+
+  let pp_env ppf = function
+    | `All -> Fmt.string ppf "`All"
+    | `One ocaml_env -> Fmt.pf ppf "(`One %a)" pp_ocaml_env ocaml_env
+  in
+
+  let pp_prelude ppf (env, filename) =
+    Fmt.pf ppf "(%a, %S)" pp_env env filename
+  in
+
+  let pp_preludes ppf preludes =
+    Fmt.pf ppf "[%a]\n" (Fmt.list ~sep:(Fmt.any "; ") pp_prelude) preludes
+  in
+
   line "let run_exn_defaults =";
   line "  let open Mdx_test in";
   line "  let packages =";
@@ -46,13 +66,14 @@ let run (`Setup ()) (`Prelude prelude) (`Directories dirs) =
   line "    ~output:(Some `Stdout)";
 
   line "let file = Sys.argv.(1)";
-  line "let prelude = %s" (list prelude);
+  line "let prelude = %a" pp_preludes prelude;
   line "let directives = List.map (fun path ->";
-  line "  Mdx_top.Directory path) %s" (list dirs);
+  line "  Mdx_top.Directory path) %a" pp_list dirs;
   line "let _ = run_exn_defaults";
   line "  ~file";
   line "  ~prelude";
   line "  ~directives";
+  Fmt.flush ppf ();
   Buffer.output_buffer stdout buffer;
   0
 

lib/ocaml_env.ml

@@ -3,6 +3,10 @@ type t = Default | User_defined of string
 let mk = function None | Some "" -> Default | Some s -> User_defined s
 let name = function Default -> "" | User_defined s -> s
 
+let pp ppf = function
+  | Default -> Fmt.string ppf "Default"
+  | User_defined s -> Fmt.pf ppf "User_defined %S" s
+
 type env = t
 
 module Set = Set.Make (struct

lib/ocaml_env.mli

@@ -2,6 +2,7 @@
 
 type t = Default | User_defined of string
 
+val pp : t Fmt.t
 val name : t -> string
 val mk : string option -> t
 

lib/prelude.ml

@@ -14,7 +14,14 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-let env_and_file f =
+type t = [ `All | `One of Ocaml_env.t ] * string
+
+let pp ppf = function
+  | `All, filename -> Fmt.pf ppf "(`All, %S)" filename
+  | `One ocaml_env, filename ->
+      Fmt.pf ppf "(`One %a, %S)" Ocaml_env.pp ocaml_env filename
+
+let env_and_payload f =
   match Astring.String.cut ~sep:":" f with
   | None -> (`All, f)
   | Some (e, f) ->

lib/prelude.mli

@@ -14,9 +14,13 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-val env_and_file : string -> [ `All | `One of Ocaml_env.t ] * string
-(** [env_and_file s] returns the environment and file/prelude string described
+type t = [ `All | `One of Ocaml_env.t ] * string
+
+val pp : t Fmt.t
+
+val env_and_payload : string -> t
+(** [env_and_payload s] returns the environment and file/prelude string described
     by [s].
-    I.e. [env_and_file "a:f"] associates [f] to the environment named [a],
-    [env_and_file " :f"] associates [f] to the default environment, and
-    [env_and_file "f"] associates [f] to all environments. *)
+    I.e. [env_and_payload "a:f"] associates [f] to the environment named [a],
+    [env_and_payload " :f"] associates [f] to the default environment, and
+    [env_and_payload "f"] associates [f] to all environments. *)

lib/test/mdx_test.ml

@@ -314,15 +314,13 @@ let with_non_det ~on_skip_execution ~on_keep_old_output ~on_evaluation
   | _ -> on_evaluation ()
 
 let preludes ~prelude ~prelude_str =
-  let aux to_lines p =
-    let env, file = Mdx.Prelude.env_and_file p in
-    (env, to_lines file)
-  in
+  let parse_str (env, content) = (env, [ content ]) in
+  let parse (env, file) = (env, Mdx.Util.File.read_lines file) in
   match (prelude, prelude_str) with
   | [], [] -> []
-  | [], fs -> List.map (aux (fun x -> [ x ])) fs
-  | fs, [] -> List.map (aux Mdx.Util.File.read_lines) fs
-  | _ -> Fmt.failwith "only one of --prelude or --prelude-str shoud be used"
+  | [], fs -> List.map parse_str fs
+  | fs, [] -> List.map parse fs
+  | _ -> Fmt.failwith "only one of --prelude or --prelude-str should be used"
 
 let run_exn ~non_deterministic ~silent_eval ~record_backtrace ~syntax ~silent
     ~verbose_findlib ~prelude ~prelude_str ~file ~section ~root ~force_output

lib/test/mdx_test.mli

@@ -19,8 +19,8 @@ val run_exn :
   syntax:Mdx.Syntax.t option ->
   silent:bool ->
   verbose_findlib:bool ->
-  prelude:string list ->
-  prelude_str:string list ->
+  prelude:Mdx.Prelude.t list ->
+  prelude_str:Mdx.Prelude.t list ->
   file:string ->
   section:string option ->
   root:string option ->

test/bin/mdx-dune-gen/misc/basic/dune.gen.expected

@@ -22,7 +22,7 @@ let run_exn_defaults =
     ~root:None ~force_output:false
     ~output:(Some `Stdout)
 let file = Sys.argv.(1)
-let prelude = ["prelude.ml";"prelude2.ml"]
+let prelude = [(`All, "prelude.ml"); (`All, "prelude2.ml")]
 
 let directives = List.map (fun path ->
   Mdx_top.Directory path) []