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 #265

Co-authored-by: Rudi Grinberg <[email protected]>
Signed-off-by: Ali Caglayan <[email protected]>

CHANGES.md

@@ -48,6 +48,10 @@ Unreleased
 - Respect `-p` / `--only-packages` for `melange.emit` artifacts (#7849,
   @anmonteiro)
 
+- Add commands `dune show targets` and `dune show aliases`, which are similar to
+  `ls`, 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,159 @@
+open Import
+
+let ls_term fetch_results =
+  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 (build_system : 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 ->
+          let dir = Path.of_string path in
+          let root =
+            match (dir : Path.t) with
+            | External _ ->
+              User_error.raise
+                [ Pp.textf
+                    "Directories outside of the project are not supported: %s"
+                    (Path.to_string_maybe_quoted dir)
+                ]
+            | In_source_tree d -> d
+            | In_build_dir d -> (
+              (* 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
+          let* () =
+            Action_builder.of_memo
+            @@
+            let open Memo.O in
+            let* exists = Source_tree.find_dir root 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. *)
+              (* First we need to determine the build directory *)
+              let build_dir =
+                match (dir : Path.t) with
+                | In_build_dir d -> d
+                | External e ->
+                  Code_error.raise
+                    "aliases_targets: check for external should have already \
+                     happened"
+                    [ ("external", Path.External.to_dyn e) ]
+                | In_source_tree d ->
+                  Path.Build.append_source
+                    (Dune_engine.Context_name.build_dir context)
+                    d
+              in
+              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 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_system root dir in
+          (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 (build_system : Dune_rules.Main.build_system) root
+      (_dir : Path.t) =
+    let open Action_builder.O in
+    let+ alias_targets =
+      let+ load_dir =
+        Action_builder.List.map build_system.contexts ~f:(fun ctx ->
+            let dir =
+              Path.Build.append_source
+                (Dune_engine.Context_name.build_dir (Context.name ctx))
+                root
+              |> Path.build
+            in
+            Action_builder.of_memo (Load_rules.load_dir ~dir))
+      in
+      List.fold_left load_dir ~init:Dune_engine.Alias.Name.Map.empty
+        ~f:(fun acc x ->
+          match (x : Load_rules.Loaded.t) with
+          | Build build ->
+            Dune_engine.Alias.Name.Map.superpose acc build.aliases
+          | _ -> acc)
+      |> Dune_engine.Alias.Name.Map.keys
+    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 (_ : Dune_rules.Main.build_system) root dir =
+    let open Action_builder.O in
+    let+ targets =
+      let open Memo.O in
+      Target.all_direct_targets (Some root)
+      >>| Path.Build.Map.to_list |> Action_builder.of_memo
+    in
+    List.map targets
+      ~f:
+        (if Path.is_in_build_dir dir then fun (path, k) -> (Path.build path, k)
+        else fun (path, k) ->
+          match Path.Build.extract_build_context path with
+          | None -> (Path.build path, k)
+          | Some (_, path) -> (Path.source path, k))
+    |> (* Only suggest hints for the basename, otherwise it's slow when there
+          are lots of files *)
+    List.filter_map ~f:(fun (path, kind) ->
+        match Path.equal (Path.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.basename path
+            | Directory -> Path.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,107 @@
+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

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)