refactor: use Command.Args.t for Modules.pp (#8109)

* refactor: use Command.Args.t for Modules.pp This allows using the concatenation DSL instead of list and string manipulation. Signed-off-by: Etienne Millon <me@emillon.org>
ocaml · Jul 6, 2023 · 1d0030a · 1d0030a
1 parent 721b4cd
commit 1d0030a
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 33 deletions.
diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml
@@ -203,15 +203,11 @@ let build_cm cctx ~force_write_cmi ~precompiled_cmi ~cm_kind (m : Module.t)
      else Command.Args.empty
    in
    let flags, sandbox =
-     let flags = Ocaml_flags.get (CC.flags cctx) mode in
+     let flags = Command.Args.dyn (Ocaml_flags.get (CC.flags cctx) mode) in
      match Module.pp_flags m with
      | None -> (flags, sandbox)
      | Some (pp, sandbox') ->
-       ( (let open Action_builder.O in
-          let+ flags = flags
-          and+ pp_flags = pp in
-          flags @ pp_flags)
-       , Sandbox_config.inter sandbox sandbox' )
+       (S [ flags; Command.Args.dyn pp ], Sandbox_config.inter sandbox sandbox')
    in
    let output =
      match phase with
@@ -251,7 +247,7 @@ let build_cm cctx ~force_write_cmi ~precompiled_cmi ~cm_kind (m : Module.t)
       Action_builder.with_no_targets (Action_builder.paths extra_deps)
       >>> Action_builder.with_no_targets other_cm_files
       >>> Command.run ~dir:(Path.build ctx.build_dir) compiler
-            [ Command.Args.dyn flags
+            [ flags
             ; cmt_args
             ; Command.Args.S obj_dirs
             ; Command.Args.as_any

diff --git a/src/dune_rules/preprocessing.ml b/src/dune_rules/preprocessing.ml
@@ -625,32 +625,20 @@ let pp_one_module sctx ~lib_name ~scope ~preprocessor_deps
     @@
     if staged then
       let dash_ppx_flag =
-        Action_builder.memoize ~cutoff:(List.equal String.equal) "ppx command"
-          (let* () = Action_builder.return () in
-           let* exe, driver, flags =
-             ppx_driver_and_flags sctx ~expander ~loc ~scope ~flags ~lib_name
-               pps
-           in
-           let+ () = Action_builder.path (Path.build exe)
-           and+ () = preprocessor_deps
-           and+ driver_flags =
-             Expander.expand_and_eval_set expander driver.info.as_ppx_flags
-               ~standard:(Action_builder.return [ "--as-ppx" ])
-           in
-           let driver_flags = driver_flags in
-           let command =
-             List.map ~f:String.quote_for_shell
-               (List.concat
-                  [ [ Path.reach (Path.build exe)
-                        ~from:
-                          (Path.build (Super_context.context sctx).build_dir)
-                    ]
-                  ; driver_flags
-                  ; flags
-                  ])
-             |> String.concat ~sep:" "
-           in
-           [ "-ppx"; command ])
+        let+ args =
+          Action_builder.memoize ~cutoff:(List.equal String.equal) "ppx command"
+            (let* exe, driver, flags =
+               ppx_driver_and_flags sctx ~expander ~loc ~scope ~flags ~lib_name
+                 pps
+             in
+             let* driver_flags =
+               Expander.expand_and_eval_set expander driver.info.as_ppx_flags
+                 ~standard:(Action_builder.return [ "--as-ppx" ])
+             and* () = preprocessor_deps in
+             Command.expand_no_targets ~dir:(Path.build dir)
+               (S [ Dep (Path.build exe); As driver_flags; As flags ]))
+        in
+        [ "-ppx"; String.quote_list_for_shell args ]
       in
       let pp =
         let sandbox =