29136

Committed 23 Nov 2024 08:04PM UTC coverage: 6.926%. Remained the same

Build # 29136

Build Type

push

github

Committed by

web-flow

Commit Message

refactor: diff actions in formatting without super context (#11149)

The diff actions aren't affected by the environment loaded in the super
context so we don't need to load it.

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

Run Details

0 of 3 new or added lines in 1 file covered. (0.0%)

93 existing lines in 2 files now uncovered.

2956 of 42680 relevant lines covered (6.93%)

26691.3 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 ~input ~output ~expander kind =
  let* ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in
  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 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 ~input ~output ~expander kind
     |> Memo.bind ~f:(Super_context.add_rule sctx ~mode:Standard ~loc ~dir)
     >>> 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 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 ]
            |> Super_context.add_rule sctx ~mode:Standard ~loc ~dir
            >>> 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* sctx = sctx in
    let expander = Super_context.expander sctx ~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)	×
NEW 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 ~input ~output ~expander kind =
124	let* ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in	×
125	match (format : Dialect.Format.t) with	×
126	\| Ocamlformat when ocamlformat_is_locked ->	×
127	Memo.return (Ocamlformat.action_when_ocamlformat_is_locked ~input ~output kind)	×
128	\| _ ->	×
129	assert (not ocamlformat_is_locked);	×
130	let loc, (action, extra_deps) =
131	match format with
132	\| Ocamlformat ->	×
133	Loc.none, Ocamlformat.action_when_ocamlformat_isn't_locked ~input kind	×
134	\| Action (loc, action) -> loc, (action, With_targets.return ())	×
135	in
136	let+ expander = expander in
UNCOV 137	let open Action_builder.With_targets.O in	×
138	extra_deps
139	>>> Pp_spec_rules.action_for_pp_with_target
140	~sandbox:Sandbox_config.default
141	~loc
142	~expander
143	~action
144	~src:input
145	~target:output
146	;;
147
148	let gen_rules_output
149	sctx
150	(config : Format_config.t)
151	~version
152	~dialects
153	~expander
154	~output_dir
155	=
UNCOV 156	assert (formatted_dir_basename = Path.Build.basename output_dir);	×
157	let loc = Format_config.loc config in
158	let dir = Path.Build.parent_exn output_dir in	×
UNCOV 159	let alias_formatted = Alias.fmt ~dir:output_dir 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	×
UNCOV 164	let open Option.O in	×
165	let* dialect, kind =
UNCOV 166	Path.Source.extension file \|> Dialect.DB.find_by_extension dialects	×
167	in
168	let* () =	×
UNCOV 169	Option.some_if (Format_config.includes config (Dialect (Dialect.name dialect))) ()	×
170	in
UNCOV 171	let+ format =	×
172	match Dialect.format dialect kind with
173	\| Some _ as action -> action	×
UNCOV 174	\| None ->	×
175	(match Dialect.preprocess dialect kind with
176	\| None -> Dialect.format Dialect.ocaml kind	×
UNCOV 177	\| Some _ -> None)	×
178	in
179	format_action format ~input ~output ~expander kind	×
180	\|> Memo.bind ~f:(Super_context.add_rule sctx ~mode:Standard ~loc ~dir)	×
NEW 181	>>> add_diff loc alias_formatted ~input:(Path.build input) ~output)	×
182	\|> Memo.Option.iter ~f:Fun.id
183	in
184	let* source_dir = Source_tree.find_dir (Path.Build.drop_build_context_exn dir) in	×
185	let* () =	×
186	Memo.Option.iter source_dir ~f:(fun source_dir ->	×
187	Source_tree.Dir.filenames source_dir	×
188	\|> Filename.Set.to_seq	×
189	\|> Memo.parallel_iter_seq ~f:(fun file ->	×
UNCOV 190	Path.Source.relative (Source_tree.Dir.path source_dir) file \|> setup_formatting))	×
191	and* () =
192	match Format_config.includes config Dune with
193	\| false -> Memo.return ()	×
194	\| true ->	×
195	Memo.Option.iter source_dir ~f:(fun source_dir ->	×
196	Source_tree.Dir.dune_file source_dir	×
197	\|> Memo.Option.iter ~f:(fun f ->	×
198	Dune_file0.path f	×
199	\|> Memo.Option.iter ~f:(fun path ->	×
200	let input_basename = Path.Source.basename path in	×
201	let input = Path.build (Path.Build.relative dir input_basename) in	×
202	let output = Path.Build.relative output_dir input_basename in	×
203	(let open Action_builder.O in	×
204	let+ () = Action_builder.path input in	×
UNCOV 205	Action.Full.make (action ~version input output))	×
206	\|> Action_builder.with_file_targets ~file_targets:[ output ]
207	\|> Super_context.add_rule sctx ~mode:Standard ~loc ~dir	×
NEW 208	>>> add_diff loc alias_formatted ~input ~output)))	×
209	in
UNCOV 210	Rules.Produce.Alias.add_deps alias_formatted (Action_builder.return ())	×
211	;;
212
213	let format_config ~dir =
UNCOV 214	let+ value =	×
215	Env_stanza_db.value_opt ~dir ~f:(fun (t : Dune_env.config) ->
UNCOV 216	Memo.return t.format_config)	×
217	and+ default =
218	(* we always force the default for error checking *)
219	Path.Build.drop_build_context_exn dir
220	\|> Source_tree.nearest_dir	×
221	>>\| Source_tree.Dir.project	×
UNCOV 222	>>\| Dune_project.format_config	×
223	in
UNCOV 224	Option.value value ~default	×
225	;;
226
227	let with_config ~dir f =
228	let* config = format_config ~dir in	×
UNCOV 229	if Format_config.is_empty config	×
230	then
231	(* CR-rgrinberg: this [is_empty] check is weird. We should use [None]
232	to represent that no settings have been set. *)
233	Memo.return ()	×
UNCOV 234	else f config	×
235	;;
236
237	let gen_rules sctx ~output_dir =
238	let dir = Path.Build.parent_exn output_dir in	×
239	with_config ~dir (fun config ->	×
240	let* sctx = sctx in	×
241	let expander = Super_context.expander sctx ~dir in	×
242	let* project = Dune_load.find_project ~dir in	×
243	let dialects = Dune_project.dialects project in	×
UNCOV 244	let version = Dune_project.dune_version project in	×
UNCOV 245	gen_rules_output sctx config ~version ~dialects ~expander ~output_dir)	×
246	;;
247
248	let setup_alias ~dir =
249	with_config ~dir (fun (_ : Format_config.t) ->	×
UNCOV 250	let output_dir = Path.Build.relative dir formatted_dir_basename in	×
251	let alias = Alias.fmt ~dir in	×
252	let alias_formatted = Alias.fmt ~dir:output_dir in
UNCOV 253	Rules.Produce.Alias.add_deps alias (Action_builder.dep (Dep.alias alias_formatted)))	×
254	;;

ocaml / dune / 29136

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