diff --git a/CHANGES.md b/CHANGES.md index 9c693f15668..6e995537b3c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -51,6 +51,10 @@ Unreleased - Respect `-p` / `--only-packages` for `melange.emit` artifacts (#7849, @anmonteiro) +- Add commands `dune show targets` and `dune show aliases` that display all the + available targets and aliases in a given directory respectively. (#7770, + grants #265, @Alizter) + - Fix scanning of Coq installed files (@ejgallego, reported by @palmskog, #7895 , fixes #7893) diff --git a/bin/describe/aliases_targets.ml b/bin/describe/aliases_targets.ml new file mode 100644 index 00000000000..77df8bd8924 --- /dev/null +++ b/bin/describe/aliases_targets.ml @@ -0,0 +1,138 @@ +open Import + +let ls_term (fetch_results : Path.Build.t -> string list Action_builder.t) = + let+ common = Common.term + and+ paths = Arg.(value & pos_all string [ "." ] & info [] ~docv:"DIR") + and+ context = + Common.context_arg + ~doc:"The context to look in. Defaults to the default context." + in + let config = Common.init common in + let request (_ : Dune_rules.Main.build_system) = + let header = List.length paths > 1 in + let open Action_builder.O in + let+ paragraphs = + Action_builder.List.map paths ~f:(fun path -> + (* The user supplied directory *) + let dir = Path.of_string path in + (* The _build and source tree version of this directory *) + let build_dir, src_dir = + match (dir : Path.t) with + | In_source_tree d -> + ( Path.Build.append_source + (Dune_engine.Context_name.build_dir context) + d + , d ) + | In_build_dir d -> + let src_dir = + (* We only drop the build context if it is correct. *) + match Path.Build.extract_build_context d with + | Some (dir_context_name, d) -> + if + Dune_engine.Context_name.equal context + (Dune_engine.Context_name.of_string dir_context_name) + then d + else + User_error.raise + [ Pp.textf "Directory %s is not in context %S." + (Path.to_string_maybe_quoted dir) + (Dune_engine.Context_name.to_string context) + ] + | None -> + Code_error.raise "aliases_targets: build dir without context" + [] + in + (d, src_dir) + | External _ -> + User_error.raise + [ Pp.textf + "Directories outside of the project are not supported: %s" + (Path.to_string_maybe_quoted dir) + ] + in + (* Check if the directory exists. *) + let* () = + Action_builder.of_memo + @@ + let open Memo.O in + let* exists = Source_tree.find_dir src_dir in + match exists with + | Some _ -> Memo.return () + | None -> + (* The directory didn't exist. We therefore check if it was a + directory target and error for the user accordingly. *) + let+ is_dir_target = + Load_rules.is_under_directory_target (Path.build build_dir) + in + if is_dir_target then + User_error.raise + [ Pp.textf + "Directory %s is a directory target. This command does \ + not support the inspection of directory targets." + (Path.to_string dir) + ] + else + User_error.raise + [ Pp.textf "Directory %s does not exist." (Path.to_string dir) + ] + in + let+ targets = fetch_results build_dir in + (* If we are printing multiple directories, we print the directory + name as a header. *) + (if header then [ Pp.textf "%s:" (Path.to_string dir) ] else []) + @ [ Pp.concat_map targets ~f:Pp.text ~sep:Pp.newline ] + |> Pp.concat ~sep:Pp.newline) + in + Console.print [ Pp.concat paragraphs ~sep:(Pp.seq Pp.newline Pp.newline) ] + in + Scheduler.go ~common ~config @@ fun () -> + let open Fiber.O in + Build_cmd.run_build_system ~common ~request + >>| fun (_ : (unit, [ `Already_reported ]) result) -> () + +module Aliases_cmd = struct + let fetch_results (dir : Path.Build.t) = + let open Action_builder.O in + let+ alias_targets = + let+ load_dir = + Action_builder.of_memo (Load_rules.load_dir ~dir:(Path.build dir)) + in + match load_dir with + | Load_rules.Loaded.Build build -> + Dune_engine.Alias.Name.Map.keys build.aliases + | _ -> [] + in + List.map ~f:Dune_engine.Alias.Name.to_string alias_targets + + let term = ls_term fetch_results + + let command = + let doc = "Print aliases in a given directory. Works similalry to ls." in + Cmd.v (Cmd.info "aliases" ~doc ~envs:Common.envs) term +end + +module Targets_cmd = struct + let fetch_results (dir : Path.Build.t) = + let open Action_builder.O in + let+ targets = + let open Memo.O in + Target.all_direct_targets (Some (Path.Build.drop_build_context_exn dir)) + >>| Path.Build.Map.to_list |> Action_builder.of_memo + in + List.filter_map targets ~f:(fun (path, kind) -> + match Path.Build.equal (Path.Build.parent_exn path) dir with + | false -> None + | true -> + (* directory targets can be distinguied by the trailing path seperator + *) + Some + (match kind with + | Target.File -> Path.Build.basename path + | Directory -> Path.Build.basename path ^ Filename.dir_sep)) + + let term = ls_term fetch_results + + let command = + let doc = "Print targets in a given directory. Works similalry to ls." in + Cmd.v (Cmd.info "targets" ~doc ~envs:Common.envs) term +end diff --git a/bin/describe/aliases_targets.mli b/bin/describe/aliases_targets.mli new file mode 100644 index 00000000000..8cc402e2dfc --- /dev/null +++ b/bin/describe/aliases_targets.mli @@ -0,0 +1,15 @@ +open Import + +(** ls like commands for showing aliases and targets *) + +module Aliases_cmd : sig + (** The aliases command lists all the aliases available in the given + directory, defaulting to the current working direcctory. *) + val command : unit Cmd.t +end + +module Targets_cmd : sig + (** The targets command lists all the targets available in the given + directory, defaulting to the current working direcctory. *) + val command : unit Cmd.t +end diff --git a/bin/describe/describe.ml b/bin/describe/describe.ml index b06480b16d2..3d0a7003d46 100644 --- a/bin/describe/describe.ml +++ b/bin/describe/describe.ml @@ -13,6 +13,8 @@ let subcommands = ; Describe_opam_files.command ; Describe_pp.command ; Printenv.command + ; Aliases_targets.Targets_cmd.command + ; Aliases_targets.Aliases_cmd.command ] let group = diff --git a/test/blackbox-tests/test-cases/describe/aliases.t/dune-project b/test/blackbox-tests/test-cases/describe/aliases.t/dune-project new file mode 100644 index 00000000000..0ececa7d7ff --- /dev/null +++ b/test/blackbox-tests/test-cases/describe/aliases.t/dune-project @@ -0,0 +1 @@ +(lang dune 3.8) diff --git a/test/blackbox-tests/test-cases/describe/aliases.t/run.t b/test/blackbox-tests/test-cases/describe/aliases.t/run.t new file mode 100644 index 00000000000..b365dfae17b --- /dev/null +++ b/test/blackbox-tests/test-cases/describe/aliases.t/run.t @@ -0,0 +1,126 @@ +Testing the "dune show aliases" command. This command shows the aliases in the +current directory. It acts similarly to ls. It will not show aliases that appear +in subdirectories although this could be changed in the future. + +In an empty dune project, the following aliases are available. + + $ dune show aliases + all + default + fmt + +User defined aliases can be added to a dune file. These should be picked up by +the command. + + $ cat > dune << EOF + > (alias + > (name foo)) + > EOF + + $ dune show aliases + all + default + fmt + foo + +Aliases in subdirectories should not be picked up. + + $ mkdir subdir + $ cat > subdir/dune << EOF + > (alias + > (name bar)) + > EOF + + $ dune show aliases + all + default + fmt + foo + +But checking the subdirectory it should be available. + + $ dune show aliases subdir + all + bar + default + fmt + +Adding an OCaml library will introduce OCaml specific aliases: + + $ cat > dune << EOF + > (library + > (name foo)) + > EOF + + $ dune show aliases + all + check + default + doc-private + fmt + +Adding a cram test will introduce an alias with the name of the test and also +introduce the runtest alias: +bbb + $ rm dune + $ cat > mytest.t + + $ dune show aliases + all + default + fmt + mytest + runtest + +We can also show aliases in multiple directories at once: + + $ dune show aliases . subdir + .: + all + default + fmt + mytest + runtest + + subdir: + all + bar + default + fmt + +Including those in the _build/ directory: + + $ dune build + $ dune show aliases . _build/default + .: + all + default + fmt + mytest + runtest + + _build/default: + all + default + fmt + mytest + runtest + +These are context sensative: + + $ cat > dune-workspace << EOF + > (lang dune 3.9) + > (context + > (default + > (name other_context))) + > EOF + + $ dune show aliases --context other_context _build/default + Error: Directory _build/default is not in context "other_context". + + $ dune show aliases --context other_context _build/other_context + all + default + fmt + mytest + runtest diff --git a/test/blackbox-tests/test-cases/describe/targets.t/a.ml b/test/blackbox-tests/test-cases/describe/targets.t/a.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/describe/targets.t/b/c.ml b/test/blackbox-tests/test-cases/describe/targets.t/b/c.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/describe/targets.t/b/dune b/test/blackbox-tests/test-cases/describe/targets.t/b/dune new file mode 100644 index 00000000000..67231e9fe24 --- /dev/null +++ b/test/blackbox-tests/test-cases/describe/targets.t/b/dune @@ -0,0 +1,2 @@ +(library + (name simple2)) diff --git a/test/blackbox-tests/test-cases/describe/targets.t/dune b/test/blackbox-tests/test-cases/describe/targets.t/dune new file mode 100644 index 00000000000..81c6345a533 --- /dev/null +++ b/test/blackbox-tests/test-cases/describe/targets.t/dune @@ -0,0 +1,10 @@ +(library + (name simple)) + +(rule + (targets + (dir d)) + (action + (progn + (run mkdir d) + (run cat > d/foo)))) diff --git a/test/blackbox-tests/test-cases/describe/targets.t/dune-project b/test/blackbox-tests/test-cases/describe/targets.t/dune-project new file mode 100644 index 00000000000..c9932b31e04 --- /dev/null +++ b/test/blackbox-tests/test-cases/describe/targets.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.8) +(using directory-targets 0.1) diff --git a/test/blackbox-tests/test-cases/describe/targets.t/run.t b/test/blackbox-tests/test-cases/describe/targets.t/run.t new file mode 100644 index 00000000000..bc69067d944 --- /dev/null +++ b/test/blackbox-tests/test-cases/describe/targets.t/run.t @@ -0,0 +1,91 @@ +Testing the "dune show targets" command in a simple OCaml project with an +additional directory target to see the behaviour there. + +We have two libraries with one in a subdirectory. We also have a directory +target d to see how the command will behave. + +With no directory provided to the command, it should default to the current +working directory. + + $ dune show targets + a.ml + d/ + dune + dune-project + simple.a + simple.cma + simple.cmxa + simple.cmxs + simple.ml-gen + +Multiple directories can be provided to the command. Also subdirectories may be +used, and only the targets available in that directory will be displayed. + + $ dune show targets . b/ + .: + a.ml + d/ + dune + dune-project + simple.a + simple.cma + simple.cmxa + simple.cmxs + simple.ml-gen + + b: + c.ml + dune + simple2.a + simple2.cma + simple2.cmxa + simple2.cmxs + simple2.ml-gen + +The command also works with files in the _build directory. + + $ dune show targets _build/default/ + a.ml + d/ + dune + dune-project + simple.a + simple.cma + simple.cmxa + simple.cmxs + simple.ml-gen + + $ dune show targets _build/default/b + c.ml + dune + simple2.a + simple2.cma + simple2.cmxa + simple2.cmxs + simple2.ml-gen + +We cannot see inside directory targets + + $ dune show targets d + Error: Directory d is a directory target. This command does not support the + inspection of directory targets. + +And we error on non-existent directories + + $ dune show targets non-existent + Error: Directory non-existent does not exist. + +We error if we are in the wrong context + + $ dune show targets _build/other_context + Error: Directory _build/other_context is not in context "default". + + $ cat > dune-workspace << EOF + > (lang dune 3.9) + > (context + > (default + > (name other_context))) + > EOF + + $ dune show targets --context other_context _build/default + Error: Directory _build/default is not in context "other_context".