Skip to content

Commit

Permalink
fix: allow [$ dune subst] to work without a repo
Browse files Browse the repository at this point in the history 
Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: f64f12f2-a4d9-4de3-a800-a61cc9af0e4f -->
  • Loading branch information
@rgrinberg
rgrinberg committed Oct 26, 2024
1 parent bdbd30c commit 2dbec42
Show file tree
Hide file tree
Showing 2 changed files with 130 additions and 98 deletions.
224 changes: 128 additions & 96 deletions bin/subst.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -299,111 +299,143 @@ let make_watermark_map ~commit ~version ~dune_project ~info =

let subst vcs =
let open Memo.O in
let* (version, commit), files =
Memo.fork_and_join
(fun () ->
Memo.fork_and_join (fun () -> Vcs.describe vcs) (fun () -> Vcs.commit_id vcs))
(fun () -> Vcs.files vcs)
in
let+ (dune_project : Dune_project.t) =
(let files =
(* Filter-out files form sub-directories *)
List.fold_left files ~init:String.Set.empty ~f:(fun acc fn ->
let fn = Path.source fn in
if Path.is_root (Path.parent_exn fn)
then String.Set.add acc (Path.to_string fn)
else acc)
in
Dune_project.load ~dir:Path.Source.root ~files ~infer_from_opam_files:true)
>>| function
| Some dune_project -> dune_project
| None ->
User_error.raise
~loc:(Loc.in_dir (Path.source Path.Source.root))
[ Pp.text
"There is no dune-project file in the current directory, please add one with \
a (name <name>) field in it."
]
~hints:
[ Pp.concat
~sep:Pp.space
[ User_message.command "dune subst"
; Pp.text "must be executed from the root of the project."
]
|> Pp.hovbox
]
in
(let loc, subst_config = Dune_project.subst_config dune_project.project in
match subst_config with
| `Enabled -> ()
| `Disabled ->
User_error.raise
~loc
[ Pp.concat
~sep:Pp.space
[ User_message.command "dune subst"
; Pp.text "has been disabled in this project. Any use of it is forbidden."
]
]
~hints:
[ Pp.text
"If you wish to re-enable it, change to (subst enabled) in the dune-project \
file."
]);
let info =
let loc, name =
match dune_project.name with
(match vcs with
| Some vcs ->
let+ version = Vcs.describe vcs
and+ commit_id = Vcs.commit_id vcs
and+ files = Vcs.files vcs in
Some (version, commit_id, files)
| None ->
(* We have to do this because scanning the source tree evaluates [-p].
That's because [-p] is needed to interpret packages in dune projects
correctly. It should not be necessary, so we should probably make the
package loading lazier. *)
Dune_rules.Only_packages.Clflags.set No_restriction;
let* root = Source_tree.root () in
let project = Source_tree.Dir.project root in
if Dune_project.dune_version project < (3, 17)
then Memo.return None
else
let+ files =
let module Map_reduce =
Source_tree.Dir.Make_map_reduce (Memo) (Monoid.Union (Path.Source.Set))
in
Source_tree.root ()
>>= Map_reduce.map_reduce
~traverse:Source_dir_status.Set.all
~trace_event_name:"Subst"
~f:(fun dir ->
Source_tree.Dir.filenames dir
|> Filename.Set.fold ~init:Path.Source.Set.empty ~f:(fun fname acc ->
Path.Source.relative (Source_tree.Dir.path dir) fname
|> Path.Source.Set.add acc)
|> Memo.return)
in
Some (None, None, Path.Source.Set.to_list files))
>>= Memo.Option.iter ~f:(fun (version, commit, files) ->
let+ (dune_project : Dune_project.t) =
(* CR-soon rgrinberg: unify this check with the above version check *)
(let files =
(* Filter-out files form sub-directories *)
List.fold_left files ~init:String.Set.empty ~f:(fun acc fn ->
let fn = Path.source fn in
if Path.is_root (Path.parent_exn fn)
then String.Set.add acc (Path.to_string fn)
else acc)
in
Dune_project.load ~dir:Path.Source.root ~files ~infer_from_opam_files:true)
>>| function
| Some dune_project -> dune_project
| None ->
User_error.raise
~loc:(Loc.in_file (Path.source dune_project.project_file))
[ Pp.textf
"The project name is not defined, please add a (name <name>) field to your \
dune-project file."
~loc:(Loc.in_dir (Path.source Path.Source.root))
[ Pp.text
"There is no dune-project file in the current directory, please add one \
with a (name <name>) field in it."
]
| Some n -> n.loc_of_arg, n.arg
~hints:
[ Pp.concat
~sep:Pp.space
[ User_message.command "dune subst"
; Pp.text "must be executed from the root of the project."
]
|> Pp.hovbox
]
in
let package_named_after_project =
let packages = Dune_project.including_hidden_packages dune_project.project in
Package.Name.Map.find packages name
(let loc, subst_config = Dune_project.subst_config dune_project.project in
match subst_config with
| `Enabled -> ()
| `Disabled ->
User_error.raise
~loc
[ Pp.concat
~sep:Pp.space
[ User_message.command "dune subst"
; Pp.text "has been disabled in this project. Any use of it is forbidden."
]
]
~hints:
[ Pp.text
"If you wish to re-enable it, change to (subst enabled) in the \
dune-project file."
]);
let info =
let loc, name =
match dune_project.name with
| None ->
User_error.raise
~loc:(Loc.in_file (Path.source dune_project.project_file))
[ Pp.textf
"The project name is not defined, please add a (name <name>) field to \
your dune-project file."
]
| Some n -> n.loc_of_arg, n.arg
in
let package_named_after_project =
let packages = Dune_project.including_hidden_packages dune_project.project in
Package.Name.Map.find packages name
in
let metadata_from_dune_project () = Dune_project.info dune_project.project in
let metadata_from_matching_package () =
match package_named_after_project with
| Some pkg -> Ok (Package.info pkg)
| None ->
Error
(User_error.make
~loc
[ Pp.textf "Package %s doesn't exist." (Package.Name.to_string name) ])
in
let version = Dune_project.dune_version dune_project.project in
if version >= (3, 0)
then metadata_from_dune_project ()
else if version >= (2, 8)
then (
match metadata_from_matching_package () with
| Ok p -> p
| Error _ -> metadata_from_dune_project ())
else User_error.ok_exn (metadata_from_matching_package ())
in
let metadata_from_dune_project () = Dune_project.info dune_project.project in
let metadata_from_matching_package () =
match package_named_after_project with
| Some pkg -> Ok (Package.info pkg)
| None ->
Error
(User_error.make
~loc
[ Pp.textf "Package %s doesn't exist." (Package.Name.to_string name) ])
let watermarks = make_watermark_map ~commit ~version ~dune_project ~info in
Dune_project.subst ~map:watermarks ~version dune_project;
let opam_package_files =
Dune_project.packages dune_project.project
|> Package.Name.Map.fold ~init:Path.Source.Set.empty ~f:(fun package acc ->
Path.Source.Set.add acc (Package.opam_file package))
in
let version = Dune_project.dune_version dune_project.project in
if version >= (3, 0)
then metadata_from_dune_project ()
else if version >= (2, 8)
then (
match metadata_from_matching_package () with
| Ok p -> p
| Error _ -> metadata_from_dune_project ())
else User_error.ok_exn (metadata_from_matching_package ())
in
let watermarks = make_watermark_map ~commit ~version ~dune_project ~info in
Dune_project.subst ~map:watermarks ~version dune_project;
let opam_package_files =
Dune_project.packages dune_project.project
|> Package.Name.Map.fold ~init:Path.Source.Set.empty ~f:(fun package acc ->
Path.Source.Set.add acc (Package.opam_file package))
in
List.iter files ~f:(fun path ->
if is_a_source_file path && not (Path.Source.equal path Dune_project.filename)
then subst_file path ~map:watermarks opam_package_files)
List.iter files ~f:(fun path ->
if is_a_source_file path && not (Path.Source.equal path Dune_project.filename)
then subst_file path ~map:watermarks opam_package_files))
;;

let subst () =
match
Sys.readdir "." |> Array.to_list |> String.Set.of_list |> Vcs.Kind.of_dir_contents
with
| None -> Fiber.return ()
| Some kind -> Memo.run (subst { kind; root = Path.root })
(* CR-someday rgrinberg: use [Source_tree.nearest_vcs] *)
Sys.readdir "."
|> Array.to_list
|> String.Set.of_list
|> Vcs.Kind.of_dir_contents
|> Option.map ~f:(fun kind -> { Vcs.kind; root = Path.root })
|> subst
|> Memo.run
;;

(** A string that is "%%VERSION%%" but not expanded by [dune subst] *)
Expand Down
4 changes: 2 additions & 2 deletions test/blackbox-tests/test-cases/subst/without-repo.t
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Demonstrate $ dune subst without a git repository

$ cat > dune-project << EOF
> (lang dune 3.16)
> (lang dune 3.17)
> (name test)
> EOF

Expand All @@ -10,4 +10,4 @@ Demonstrate $ dune subst without a git repository
$ dune subst

$ cat README.md
%%NAME%%
test

0 comments on commit 2dbec42

Please sign in to comment.