29147

Committed 25 Nov 2024 10:30PM UTC coverage: 6.924% (-0.001%) from 6.925%

Build # 29147

Build Type

push

github

Committed by

web-flow

Commit Message

fix(pkg): use correct environment for using format rules (#11155)

The base environment was omitted

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

Run Details

0 of 10 new or added lines in 2 files covered. (0.0%)

1 existing line in 1 file now uncovered.

2956 of 42695 relevant lines covered (6.92%)

26681.99 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/src/dune_rules/format_rules.ml

open Import
open Memo.O

let add_diff loc alias ~input ~output =
  let open Action_builder.O in
  let dir = Alias.dir alias in
  let action =
    let dir = Path.Build.parent_exn dir in
    Action.Chdir (Path.build dir, Promote.Diff_action.diff input output)
  in
  Action_builder.paths [ input; Path.build output ]
  >>> Action_builder.return (Action.Full.make action)
  |> Rules.Produce.Alias.add_action alias ~loc
;;

let rec subdirs_until_root dir =
  match Path.parent dir with
  | None -> [ dir ]
  | Some d -> dir :: subdirs_until_root d
;;

let depend_on_files ~named dir =
  subdirs_until_root dir
  |> List.concat_map ~f:(fun dir -> List.map named ~f:(Path.relative dir))
  |> Action_builder.paths_existing
;;

let formatted_dir_basename = ".formatted"

let action =
  let module Spec = struct
    type ('path, 'target) t = Dune_lang.Syntax.Version.t * 'path * 'target

    let name = "format-dune-file"
    let version = 1
    let bimap (ver, src, dst) f g = ver, f src, g dst
    let is_useful_to ~memoize = memoize

    let encode (version, src, dst) path target : Sexp.t =
      List
        [ Dune_lang.Syntax.Version.encode version |> Dune_sexp.to_sexp
        ; path src
        ; target dst
        ]
    ;;

    let action (version, src, dst) ~ectx:_ ~eenv:_ =
      Dune_lang.Format.format_action ~version ~src ~dst;
      Fiber.return ()
    ;;
  end
  in
  let module A = Action_ext.Make (Spec) in
  fun ~version (src : Path.t) (dst : Path.Build.t) -> A.action (version, src, dst)
;;

module Alias = struct
  let fmt ~dir = Alias.make Alias0.fmt ~dir
end

module Ocamlformat = struct
  let dev_tool_lock_dir_exists () =
    let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat in
    Fs_memo.dir_exists (Path.source path |> Path.as_outside_build_dir_exn)
  ;;

  (* Config files for ocamlformat. When these are changed, running
     `dune fmt` should cause ocamlformat to re-format the ocaml files
     in the project. *)
  let config_files = [ ".ocamlformat"; ".ocamlformat-ignore"; ".ocamlformat-enable" ]

  let extra_deps dir =
    (* Set up the dependency on ocamlformat config files so changing
       these files triggers ocamlformat to run again. *)
    depend_on_files ~named:config_files (Path.build dir) |> Action_builder.with_no_targets
  ;;

  let flag_of_kind = function
    | Ml_kind.Impl -> "--impl"
    | Intf -> "--intf"
  ;;

  let action_when_ocamlformat_is_locked ~input ~output kind =
    let path = Path.build @@ Pkg_dev_tool.exe_path Ocamlformat in
    let dir = Path.Build.parent_exn input in
    let action =
      (* An action which runs at on the file at [input] and stores the
         resulting diff in the file at [output] *)
      Action_builder.with_stdout_to
        output
        (let open Action_builder.O in
         (* This ensures that at is installed as a dev tool before
            running it. *)
         let+ () = Action_builder.path path
         (* Declare the dependency on the input file so changes to the input
            file trigger ocamlformat to run again on the updated file. *)
         and+ () = Action_builder.path (Path.build input) in
         let args = [ flag_of_kind kind; Path.Build.basename input ] in
         Action.chdir (Path.build dir) @@ Action.run (Ok path) args |> Action.Full.make)
    in
    let open Action_builder.With_targets.O in
    (* Depend on [extra_deps] so if the ocamlformat config file
       changes then ocamlformat will run again. *)
    extra_deps dir
    >>> action
    |> With_targets.map ~f:(Action.Full.add_sandbox Sandbox_config.needs_sandboxing)
  ;;

  let action_when_ocamlformat_isn't_locked ~input kind =
    let module S = String_with_vars in
    let dir = Path.Build.parent_exn input in
    ( Dune_lang.Action.chdir
        (S.make_pform Loc.none (Var Workspace_root))
        (Dune_lang.Action.run
           (S.make_text Loc.none (Pkg_dev_tool.exe_name Ocamlformat))
           [ S.make_text Loc.none (flag_of_kind kind)
           ; S.make_pform Loc.none (Var Input_file)
           ])
    , extra_deps dir )
  ;;
end

let format_action format ~ocamlformat_is_locked ~input ~output ~expander kind =
  match (format : Dialect.Format.t) with
  | Ocamlformat when ocamlformat_is_locked ->
    Memo.return (Ocamlformat.action_when_ocamlformat_is_locked ~input ~output kind)
  | _ ->
    assert (not ocamlformat_is_locked);
    let loc, (action, extra_deps) =
      match format with
      | Ocamlformat ->
        Loc.none, Ocamlformat.action_when_ocamlformat_isn't_locked ~input kind
      | Action (loc, action) -> loc, (action, With_targets.return ())
    in
    let+ expander = expander in
    let open Action_builder.With_targets.O in
    extra_deps
    >>> Pp_spec_rules.action_for_pp_with_target
          ~sandbox:Sandbox_config.default
          ~loc
          ~expander
          ~action
          ~src:input
          ~target:output
;;

let gen_rules_output
  sctx
  (config : Format_config.t)
  ~version
  ~dialects
  ~expander
  ~output_dir
  =
  assert (formatted_dir_basename = Path.Build.basename output_dir);
  let loc = Format_config.loc config in
  let dir = Path.Build.parent_exn output_dir in
  let alias_formatted = Alias.fmt ~dir:output_dir in
  let* ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in
  let setup_formatting file =
    (let input_basename = Path.Source.basename file in
     let input = Path.Build.relative dir input_basename in
     let output = Path.Build.relative output_dir input_basename in
     let open Option.O in
     let* dialect, kind =
       Path.Source.extension file |> Dialect.DB.find_by_extension dialects
     in
     let* () =
       Option.some_if (Format_config.includes config (Dialect (Dialect.name dialect))) ()
     in
     let+ format =
       match Dialect.format dialect kind with
       | Some _ as action -> action
       | None ->
         (match Dialect.preprocess dialect kind with
          | None -> Dialect.format Dialect.ocaml kind
          | Some _ -> None)
     in
     format_action format ~ocamlformat_is_locked ~input ~output ~expander kind
     |> Memo.bind ~f:(fun rule ->
       if ocamlformat_is_locked
       then (
         let { Action_builder.With_targets.build; targets } = rule in
         let build =
           let open Action_builder.O in
           let+ build = build
           and+ env = Action_builder.of_memo (Pkg_rules.dev_tool_env Ocamlformat) in
           Action.Full.add_env env build
         in
         Rule.make ~mode:Standard ~targets build |> Rules.Produce.rule)
       else
         let open Memo.O in
         let* sctx = sctx in
         Super_context.add_rule sctx ~mode:Standard ~loc ~dir rule)
     >>> add_diff loc alias_formatted ~input:(Path.build input) ~output)
    |> Memo.Option.iter ~f:Fun.id
  in
  let* source_dir = Source_tree.find_dir (Path.Build.drop_build_context_exn dir) in
  let* () =
    Memo.Option.iter source_dir ~f:(fun source_dir ->
      Source_tree.Dir.filenames source_dir
      |> Filename.Set.to_seq
      |> Memo.parallel_iter_seq ~f:(fun file ->
        Path.Source.relative (Source_tree.Dir.path source_dir) file |> setup_formatting))
  and* () =
    match Format_config.includes config Dune with
    | false -> Memo.return ()
    | true ->
      Memo.Option.iter source_dir ~f:(fun source_dir ->
        Source_tree.Dir.dune_file source_dir
        |> Memo.Option.iter ~f:(fun f ->
          Dune_file0.path f
          |> Memo.Option.iter ~f:(fun path ->
            let input_basename = Path.Source.basename path in
            let input = Path.build (Path.Build.relative dir input_basename) in
            let output = Path.Build.relative output_dir input_basename in
            let { Action_builder.With_targets.build; targets } =
              (let open Action_builder.O in
               let+ () = Action_builder.path input in
               Action.Full.make (action ~version input output))
              |> Action_builder.with_file_targets ~file_targets:[ output ]
            in
            let rule = Rule.make ~mode:Standard ~targets build in
            Rules.Produce.rule rule >>> add_diff loc alias_formatted ~input ~output)))
  in
  Rules.Produce.Alias.add_deps alias_formatted (Action_builder.return ())
;;

let format_config ~dir =
  let+ value =
    Env_stanza_db.value_opt ~dir ~f:(fun (t : Dune_env.config) ->
      Memo.return t.format_config)
  and+ default =
    (* we always force the default for error checking *)
    Path.Build.drop_build_context_exn dir
    |> Source_tree.nearest_dir
    >>| Source_tree.Dir.project
    >>| Dune_project.format_config
  in
  Option.value value ~default
;;

let with_config ~dir f =
  let* config = format_config ~dir in
  if Format_config.is_empty config
  then
    (* CR-rgrinberg: this [is_empty] check is weird. We should use [None]
       to represent that no settings have been set. *)
    Memo.return ()
  else f config
;;

let gen_rules sctx ~output_dir =
  let dir = Path.Build.parent_exn output_dir in
  with_config ~dir (fun config ->
    let expander = sctx >>= Super_context.expander ~dir in
    let* project = Dune_load.find_project ~dir in
    let dialects = Dune_project.dialects project in
    let version = Dune_project.dune_version project in
    gen_rules_output sctx config ~version ~dialects ~expander ~output_dir)
;;

let setup_alias ~dir =
  with_config ~dir (fun (_ : Format_config.t) ->
    let output_dir = Path.Build.relative dir formatted_dir_basename in
    let alias = Alias.fmt ~dir in
    let alias_formatted = Alias.fmt ~dir:output_dir in
    Rules.Produce.Alias.add_deps alias (Action_builder.dep (Dep.alias alias_formatted)))
;;

1	open Import
2	open Memo.O
3
4	let add_diff loc alias ~input ~output =
5	let open Action_builder.O in	×
6	let dir = Alias.dir alias in
7	let action =	×
8	let dir = Path.Build.parent_exn dir in
9	Action.Chdir (Path.build dir, Promote.Diff_action.diff input output)	×
10	in
11	Action_builder.paths [ input; Path.build output ]	×
12	>>> Action_builder.return (Action.Full.make action)	×
13	\|> Rules.Produce.Alias.add_action alias ~loc	×
14	;;
15
16	let rec subdirs_until_root dir =
17	match Path.parent dir with	×
18	\| None -> [ dir ]	×
19	\| Some d -> dir :: subdirs_until_root d	×
20	;;
21
22	let depend_on_files ~named dir =
23	subdirs_until_root dir	×
24	\|> List.concat_map ~f:(fun dir -> List.map named ~f:(Path.relative dir))	×
25	\|> Action_builder.paths_existing	×
26	;;
27
28	let formatted_dir_basename = ".formatted"
29
30	let action =
31	let module Spec = struct
32	type ('path, 'target) t = Dune_lang.Syntax.Version.t * 'path * 'target
33
34	let name = "format-dune-file"
35	let version = 1
36	let bimap (ver, src, dst) f g = ver, f src, g dst	×
37	let is_useful_to ~memoize = memoize	×
38
39	let encode (version, src, dst) path target : Sexp.t =
40	List	×
41	[ Dune_lang.Syntax.Version.encode version \|> Dune_sexp.to_sexp	×
42	; path src	×
43	; target dst	×
44	]
45	;;
46
47	let action (version, src, dst) ~ectx:_ ~eenv:_ =
48	Dune_lang.Format.format_action ~version ~src ~dst;	×
49	Fiber.return ()
50	;;
51	end
52	in
53	let module A = Action_ext.Make (Spec) in
54	fun ~version (src : Path.t) (dst : Path.Build.t) -> A.action (version, src, dst)	×
55	;;
56
57	module Alias = struct
58	let fmt ~dir = Alias.make Alias0.fmt ~dir	×
59	end
60
61	module Ocamlformat = struct
62	let dev_tool_lock_dir_exists () =
63	let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat in	×
64	Fs_memo.dir_exists (Path.source path \|> Path.as_outside_build_dir_exn)	×
65	;;
66
67	(* Config files for ocamlformat. When these are changed, running
68	`dune fmt` should cause ocamlformat to re-format the ocaml files
69	in the project. *)
70	let config_files = [ ".ocamlformat"; ".ocamlformat-ignore"; ".ocamlformat-enable" ]
71
72	let extra_deps dir =
73	(* Set up the dependency on ocamlformat config files so changing
74	these files triggers ocamlformat to run again. *)
75	depend_on_files ~named:config_files (Path.build dir) \|> Action_builder.with_no_targets	×
76	;;
77
78	let flag_of_kind = function
79	\| Ml_kind.Impl -> "--impl"	×
80	\| Intf -> "--intf"	×
81	;;
82
83	let action_when_ocamlformat_is_locked ~input ~output kind =
84	let path = Path.build @@ Pkg_dev_tool.exe_path Ocamlformat in	×
85	let dir = Path.Build.parent_exn input in	×
86	let action =	×
87	(* An action which runs at on the file at [input] and stores the
88	resulting diff in the file at [output] *)
89	Action_builder.with_stdout_to
90	output
91	(let open Action_builder.O in
92	(* This ensures that at is installed as a dev tool before
93	running it. *)
94	let+ () = Action_builder.path path	×
95	(* Declare the dependency on the input file so changes to the input
96	file trigger ocamlformat to run again on the updated file. *)
97	and+ () = Action_builder.path (Path.build input) in	×
98	let args = [ flag_of_kind kind; Path.Build.basename input ] in	×
99	Action.chdir (Path.build dir) @@ Action.run (Ok path) args \|> Action.Full.make)	×
100	in
101	let open Action_builder.With_targets.O in	×
102	(* Depend on [extra_deps] so if the ocamlformat config file
103	changes then ocamlformat will run again. *)
104	extra_deps dir	×
105	>>> action
106	\|> With_targets.map ~f:(Action.Full.add_sandbox Sandbox_config.needs_sandboxing)	×
107	;;
108
109	let action_when_ocamlformat_isn't_locked ~input kind =
110	let module S = String_with_vars in	×
111	let dir = Path.Build.parent_exn input in
112	( Dune_lang.Action.chdir	×
113	(S.make_pform Loc.none (Var Workspace_root))	×
114	(Dune_lang.Action.run	×
115	(S.make_text Loc.none (Pkg_dev_tool.exe_name Ocamlformat))	×
116	[ S.make_text Loc.none (flag_of_kind kind)	×
117	; S.make_pform Loc.none (Var Input_file)	×
118	])
119	, extra_deps dir )	×
120	;;
121	end
122
123	let format_action format ~ocamlformat_is_locked ~input ~output ~expander kind =
124	match (format : Dialect.Format.t) with	×
125	\| Ocamlformat when ocamlformat_is_locked ->	×
126	Memo.return (Ocamlformat.action_when_ocamlformat_is_locked ~input ~output kind)	×
127	\| _ ->	×
128	assert (not ocamlformat_is_locked);	×
129	let loc, (action, extra_deps) =
130	match format with
131	\| Ocamlformat ->	×
132	Loc.none, Ocamlformat.action_when_ocamlformat_isn't_locked ~input kind	×
133	\| Action (loc, action) -> loc, (action, With_targets.return ())	×
134	in
135	let+ expander = expander in
136	let open Action_builder.With_targets.O in	×
137	extra_deps
138	>>> Pp_spec_rules.action_for_pp_with_target
139	~sandbox:Sandbox_config.default
140	~loc
141	~expander
142	~action
143	~src:input
144	~target:output
145	;;
146
147	let gen_rules_output
148	sctx
149	(config : Format_config.t)
150	~version
151	~dialects
152	~expander
153	~output_dir
154	=
155	assert (formatted_dir_basename = Path.Build.basename output_dir);	×
156	let loc = Format_config.loc config in
157	let dir = Path.Build.parent_exn output_dir in	×
158	let alias_formatted = Alias.fmt ~dir:output_dir in	×
159	let* ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in	×
160	let setup_formatting file =	×
161	(let input_basename = Path.Source.basename file in	×
162	let input = Path.Build.relative dir input_basename in	×
163	let output = Path.Build.relative output_dir input_basename in	×
164	let open Option.O in	×
165	let* dialect, kind =
166	Path.Source.extension file \|> Dialect.DB.find_by_extension dialects	×
167	in
168	let* () =	×
169	Option.some_if (Format_config.includes config (Dialect (Dialect.name dialect))) ()	×
170	in
171	let+ format =	×
172	match Dialect.format dialect kind with
173	\| Some _ as action -> action	×
174	\| None ->	×
175	(match Dialect.preprocess dialect kind with
176	\| None -> Dialect.format Dialect.ocaml kind	×
177	\| Some _ -> None)	×
178	in
179	format_action format ~ocamlformat_is_locked ~input ~output ~expander kind	×
180	\|> Memo.bind ~f:(fun rule ->	×
181	if ocamlformat_is_locked	×
182	then (	×
183	let { Action_builder.With_targets.build; targets } = rule in
184	let build =
185	let open Action_builder.O in
186	let+ build = build
NEW 187	and+ env = Action_builder.of_memo (Pkg_rules.dev_tool_env Ocamlformat) in	×
NEW 188	Action.Full.add_env env build	×
189	in
UNCOV 190	Rule.make ~mode:Standard ~targets build \|> Rules.Produce.rule)	×
191	else
192	let open Memo.O in	×
193	let* sctx = sctx in
194	Super_context.add_rule sctx ~mode:Standard ~loc ~dir rule)	×
195	>>> add_diff loc alias_formatted ~input:(Path.build input) ~output)	×
196	\|> Memo.Option.iter ~f:Fun.id
197	in
198	let* source_dir = Source_tree.find_dir (Path.Build.drop_build_context_exn dir) in	×
199	let* () =	×
200	Memo.Option.iter source_dir ~f:(fun source_dir ->	×
201	Source_tree.Dir.filenames source_dir	×
202	\|> Filename.Set.to_seq	×
203	\|> Memo.parallel_iter_seq ~f:(fun file ->	×
204	Path.Source.relative (Source_tree.Dir.path source_dir) file \|> setup_formatting))	×
205	and* () =
206	match Format_config.includes config Dune with
207	\| false -> Memo.return ()	×
208	\| true ->	×
209	Memo.Option.iter source_dir ~f:(fun source_dir ->	×
210	Source_tree.Dir.dune_file source_dir	×
211	\|> Memo.Option.iter ~f:(fun f ->	×
212	Dune_file0.path f	×
213	\|> Memo.Option.iter ~f:(fun path ->	×
214	let input_basename = Path.Source.basename path in	×
215	let input = Path.build (Path.Build.relative dir input_basename) in	×
216	let output = Path.Build.relative output_dir input_basename in	×
217	let { Action_builder.With_targets.build; targets } =	×
218	(let open Action_builder.O in
219	let+ () = Action_builder.path input in	×
220	Action.Full.make (action ~version input output))	×
221	\|> Action_builder.with_file_targets ~file_targets:[ output ]
222	in
223	let rule = Rule.make ~mode:Standard ~targets build in	×
224	Rules.Produce.rule rule >>> add_diff loc alias_formatted ~input ~output)))	×
225	in
226	Rules.Produce.Alias.add_deps alias_formatted (Action_builder.return ())	×
227	;;
228
229	let format_config ~dir =
230	let+ value =	×
231	Env_stanza_db.value_opt ~dir ~f:(fun (t : Dune_env.config) ->
232	Memo.return t.format_config)	×
233	and+ default =
234	(* we always force the default for error checking *)
235	Path.Build.drop_build_context_exn dir
236	\|> Source_tree.nearest_dir	×
237	>>\| Source_tree.Dir.project	×
238	>>\| Dune_project.format_config	×
239	in
240	Option.value value ~default	×
241	;;
242
243	let with_config ~dir f =
244	let* config = format_config ~dir in	×
245	if Format_config.is_empty config	×
246	then
247	(* CR-rgrinberg: this [is_empty] check is weird. We should use [None]
248	to represent that no settings have been set. *)
249	Memo.return ()	×
250	else f config	×
251	;;
252
253	let gen_rules sctx ~output_dir =
254	let dir = Path.Build.parent_exn output_dir in	×
255	with_config ~dir (fun config ->	×
256	let expander = sctx >>= Super_context.expander ~dir in	×
257	let* project = Dune_load.find_project ~dir in	×
258	let dialects = Dune_project.dialects project in	×
259	let version = Dune_project.dune_version project in	×
260	gen_rules_output sctx config ~version ~dialects ~expander ~output_dir)	×
261	;;
262
263	let setup_alias ~dir =
264	with_config ~dir (fun (_ : Format_config.t) ->	×
265	let output_dir = Path.Build.relative dir formatted_dir_basename in	×
266	let alias = Alias.fmt ~dir in	×
267	let alias_formatted = Alias.fmt ~dir:output_dir in
268	Rules.Produce.Alias.add_deps alias (Action_builder.dep (Dep.alias alias_formatted)))	×
269	;;

ocaml / dune / 29147

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous