feature: dune show targets and dune show aliases

Add a `dune show targets` and `dune show aliases` command for showing
targets and aliases in a directory like `ls`.

fix ocaml#265

Co-authored-by: Rudi Grinberg <me@rgrinberg.com>
Signed-off-by: Ali Caglayan <alizter@gmail.com>

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)
 

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

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

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 =

test/blackbox-tests/test-cases/describe/aliases.t/dune-project

@@ -0,0 +1 @@
+(lang dune 3.8)

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

test/blackbox-tests/test-cases/describe/targets.t/b/dune

@@ -0,0 +1,2 @@
+(library
+ (name simple2))

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))))

test/blackbox-tests/test-cases/describe/targets.t/dune-project

@@ -0,0 +1,2 @@
+(lang dune 3.8)
+(using directory-targets 0.1)