Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 4 additions & 1 deletion bin/tools/group.ml
Original file line number Diff line number Diff line change
Expand Up @@ -33,4 +33,7 @@ end

let doc = "Command group for wrapped tools."
let info = Cmd.info ~doc "tools"
let group = Cmd.group info [ Exec.group; Install.group; Which.group ]

let group =
Cmd.group info [ Exec.group; Install.group; Which.group; Tools_common.env_command ]
;;
46 changes: 43 additions & 3 deletions bin/tools/tools_common.ml
Original file line number Diff line number Diff line change
@@ -1,10 +1,13 @@
open! Import
module Pkg_dev_tool = Dune_rules.Pkg_dev_tool

let dev_tool_bin_dirs =
List.map Pkg_dev_tool.all ~f:(fun tool ->
Pkg_dev_tool.exe_path tool |> Path.Build.parent_exn |> Path.build)
;;

let add_dev_tools_to_path env =
List.fold_left Pkg_dev_tool.all ~init:env ~f:(fun acc tool ->
let dir = Pkg_dev_tool.exe_path tool |> Path.Build.parent_exn |> Path.build in
Env_path.cons acc ~dir)
List.fold_left dev_tool_bin_dirs ~init:env ~f:(fun acc dir -> Env_path.cons acc ~dir)
;;

let dev_tool_exe_path dev_tool = Path.build @@ Pkg_dev_tool.exe_path dev_tool
Expand Down Expand Up @@ -137,3 +140,40 @@ let exec_command dev_tool =
in
Cmd.v info term
;;

let env_command =
let term =
let+ builder = Common.Builder.term
and+ fish =
Arg.(
value
& flag
& info [ "fish" ] ~doc:"Print command for the fish shell rather than POSIX shells")
in
let _ : Common.t * Dune_config.t = Common.init builder in
if fish
then (
let space_separated_dev_tool_paths =
List.map dev_tool_bin_dirs ~f:Path.to_string_maybe_quoted
|> String.concat ~sep:" "
in
print_endline (sprintf "fish_add_path --prepend %s" space_separated_dev_tool_paths))
else (
let initial_path = Env.get Env.initial Env_path.var in
let new_path =
List.fold_left dev_tool_bin_dirs ~init:initial_path ~f:(fun acc bin_dir ->
Copy link
Member

@shonfeder shonfeder Oct 2, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

One problem I see with this is that new env will be needed every time a new tool is installed.

Have you considered, instead, creating a single directory with all the binaries symlinked? This would ensure that once someone was "in" the dune environment, any additionally installed executables would be available immediately (as I think one would expect). It will also avoid having unnecessarily long paths.

I'm somewhat inclined to think that the desirable behavior I've described is a prerequisite for actually having an environment like this that would not be very surprising and confusing to work with. Without this simplification, I do think we run into the kinds problems @Leonidas-from-XIV is anticipating. And, on the other hand, once we have such a stable path with all the binaries, the invocation of a dune tools env operation becomes basically a trivial convenience.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Have you considered, instead, creating a single directory with all the binaries symlinked? This would ensure that once someone was "in" the dune environment, any additionally installed executables would be available immediately (as I think one would expect). It will also avoid having unnecessarily long paths.

The downside is that Dune will have to maintain a "state" of this directory, e.g. adding or removing symlinks whenever dev tools are installed, removed, updated etc. The advantage with adding directories to PATH as needed is that they're only valid until the process exits.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The downside of the former seems like a very tractable problem foe the implementation, but the upside of the latter is actually a downside for users.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I thought about it but I'm not sure exactly how to do it within the framework of dune rules (I suspect there is a way if I dig deep enough though). From a user's point of view there will be no difference though. Why do you see it as a problem to have a separate entry in PATH for each dev tool?

If/when we allow arbitrary packages to be installed as dev tools, keeping each dev tool in a separate directory will let us better handle the issue where different opam packages contain executables with the same name as each other since they won't collide in the filesystem.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh reading through your other comment I think I understand. It appears you believe that this command will only add entries to PATH for dev tools which are currently installed, however this command instead adds entries to PATH for all dev tools which dune knows about, regardless of whether they are installed. That way no env update is needed when a new tool is installed.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

On further thought, since this does behave OK w/r/t to not having the behavior or incorrectly assumed, perhaps it is good enough for the current state of things, given that there are relatively few dev tools supported. Any improved, general solution would still be compatible from an end-user perspective IIUC.

So, with the caveat that I still think it is non ideal and I don't see how the current approach can work for general dev tooling support, I think I am ok with this approach for now if others are.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Perhaps this indicates that the proposers solution here should actually go thru the design rethinking we need in the general solution to installing dev tools?

I agree with this. When dev tools were first designed the intention was that they represented the recommended way of performing certain tasks with dune that required external tools, such as launching a top-level in the project's context, generate documentation, or start an lsp server. The current UX around dev tools isn't well suited for installing arbitrary packages as dev tools. I think we should take some time to come up with a more general solution for dev tools or to introduce running exes from abitrary packages as a difference concept to dev tools entirely (however both are out of scope of this PR).

Copy link
Collaborator

@Leonidas-from-XIV Leonidas-from-XIV Oct 3, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The downside of the former seems like a very tractable problem for the implementation

It's not only that, it's also generally counter to the philosophy of package management in Dune which generally does not keep a state past the execution of a Dune command. This focus allows it to avoid all kinds of issues where the state is desynchornized from the declared configuration and keeps a focus on Dune operations being fast because they need to be quick to repeat.

So while it is possible we do need to evaluate every feature with a lens of "does it conceptually fit". Sometimes breaking that is worth it and sometimes the breakage can be contained.

I don't think that "others do it" is as good of an argument in general. e.g. Nix breaks with a lot of conventions of regular package managers and that's generally considered a good thing, otherwise one could just use these other package managers.

Copy link
Member

@shonfeder shonfeder Oct 4, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am certainly not arguing that we should do things just because other systems do it a certain way. But if we introduce added complexity to users that has no precedent and has no benefit to users, I think it is worth remarking, since familiarity and precedent can sometimes be a reason to justify choosing slightly inferior options.

Speaking of nix, it uses nix-profiles/bin to provide a single directory with binaries for users. Tho, as a counterpoint to my claim, nix-shell uses an approach like the one here, adding the separate binary dir for each package from the store into the path. I am still not keen on this, but happy to deffer on that point.

It's not only that, it's also generally counter to the philosophy of package management in Dune which generally does not keep a state past the execution of a Dune command.

Why is generation of a symlink in a directory more stateful that generation of all the other artifacts produced by package management?

From the perspective of a build problem, is there any reason in principle that we couldn't we take the production of the symlinked executable(s) in a shared ./bin directory to be the ultimate build target for tools, with the rest of the artifacts just be intermediate artifacts?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think we should take some time to come up with a more general solution for dev tools or to introduce running exes from abitrary packages as a difference concept to dev tools entirely (however both are out of scope of this PR).

Yep, makes sense to me!

Some (Bin.cons_path bin_dir ~_PATH:acc))
in
match new_path with
| None -> ()
| Some new_path -> print_endline (sprintf "export %s=%s" Env_path.var new_path))
in
let info =
let doc =
"Print a command which can be eval'd to enter an environment where all dev tools \
are runnable as commands."
in
Cmd.info "env" ~doc
in
Cmd.v info term
;;
1 change: 1 addition & 0 deletions bin/tools/tools_common.mli
Original file line number Diff line number Diff line change
Expand Up @@ -13,3 +13,4 @@ val lock_build_and_run_dev_tool
val which_command : Dune_pkg.Dev_tool.t -> unit Cmd.t
val install_command : Dune_pkg.Dev_tool.t -> unit Cmd.t
val exec_command : Dune_pkg.Dev_tool.t -> unit Cmd.t
val env_command : unit Cmd.t
Original file line number Diff line number Diff line change
Expand Up @@ -30,3 +30,9 @@ a lockdir containing an "ocaml" lockfile.
- ocaml-lsp-server.0.0.1
Running 'ocamllsp'
hello from fake ocamllsp

Make sure that after evaling the output of 'dune tools env', the first ocamllsp
executable in PATH is the one installed by dune as a dev tool.
$ DUNE_CONFIG__LOCK_DEV_TOOL=enabled eval $(dune tools env)
$ which ocamllsp
$TESTCASE_ROOT/_build/_private/default/.dev-tool/ocaml-lsp-server/ocaml-lsp-server/target/bin/ocamllsp
Loading