29210

Committed 04 Dec 2024 02:01PM UTC coverage: 6.909% (-0.003%) from 6.912%

Build # 29210

Build Type

push

github

Committed by

web-flow

Commit Message

[3.17] Merge back changelog from 3.17.0 release (#11180)

Signed-off-by: Marek Kubica <marek@tarides.com>

Run Details

2951 of 42710 relevant lines covered (6.91%)

26672.61 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"

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

ocaml / dune / 29210

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