diff --git a/bin/main.ml b/bin/main.ml index 0bcc4a9438d2..f843c5a3c73c 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -27,7 +27,6 @@ let all : _ Cmdliner.Cmd.t list = ; Ocaml_merlin.command ; Shutdown.command ; Diagnostics.command - ; Targets_cmd.command ] in let groups = @@ -37,6 +36,7 @@ let all : _ Cmdliner.Cmd.t list = ; Internal.group ; Init.group ; Promotion.group + ; Show.group ] in terms @ groups diff --git a/bin/show/aliases_cmd.ml b/bin/show/aliases_cmd.ml new file mode 100644 index 000000000000..aadd20f7bcca --- /dev/null +++ b/bin/show/aliases_cmd.ml @@ -0,0 +1,67 @@ +open Import +open Stdune + +let doc = "Print aliases in a given directory. Works similalry to ls." + +let pp_aliases ~(contexts : Context.t list) path = + let dir = Path.of_string path in + let root = + match (dir : Path.t) with + | External e -> + Code_error.raise "target_hint: external path" + [ ("path", Path.External.to_dyn e) ] + | In_source_tree d -> d + | In_build_dir d -> ( + match Path.Build.drop_build_context d with + | Some d -> d + | None -> Path.Source.root) + in + let open Action_builder.O in + let+ alias_targets = + let+ load_dir = + Action_builder.List.map 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.union + ~f:(fun _ a _ -> Some a) + acc build.aliases + | _ -> acc) + |> Dune_engine.Alias.Name.Map.to_list_map ~f:(fun name _ -> + Dune_engine.Alias.Name.to_string name) + in + [ Pp.textf "%s:" (Path.to_string dir) + ; Pp.concat_map alias_targets ~f:Pp.text ~sep:Pp.newline + ] + |> Pp.concat ~sep:Pp.newline + +let term = + let+ common = Common.term + and+ paths = Arg.(value & pos_all string [ "." ] & info [] ~docv:"DIR") in + let config = Common.init common in + let request (setup : Dune_rules.Main.build_system) = + let open Action_builder.O in + let+ paragraphs = + Action_builder.List.map paths ~f:(pp_aliases ~contexts:setup.contexts) + in + paragraphs + |> Pp.concat ~sep:(Pp.seq Pp.newline Pp.newline) + |> List.singleton |> User_message.make |> User_message.print + in + Scheduler.go ~common ~config @@ fun () -> + let open Fiber.O in + let+ res = Build_cmd.run_build_system ~common ~request in + match res with + | Error `Already_reported -> raise Dune_util.Report_error.Already_reported + | Ok () -> () + +let command = Cmd.v (Cmd.info "aliases" ~doc ~envs:Common.envs) term diff --git a/bin/show/aliases_cmd.mli b/bin/show/aliases_cmd.mli new file mode 100644 index 000000000000..1e4ac02c4aa4 --- /dev/null +++ b/bin/show/aliases_cmd.mli @@ -0,0 +1,5 @@ +open Import + +(** The aliases command lists all the aliases available in the given directory, + defaulting to the current working direcctory. *) +val command : unit Cmd.t diff --git a/bin/show/show.ml b/bin/show/show.ml new file mode 100644 index 000000000000..da31ea299df5 --- /dev/null +++ b/bin/show/show.ml @@ -0,0 +1,6 @@ +open Import + +let doc = "Command group for showing information about the workspace" + +let group = + Cmd.group (Cmd.info ~doc "show") [ Targets_cmd.command; Aliases_cmd.command ] diff --git a/bin/show/show.mli b/bin/show/show.mli new file mode 100644 index 000000000000..365c3ba35b9b --- /dev/null +++ b/bin/show/show.mli @@ -0,0 +1,4 @@ +open Import + +(** The dune show command group *) +val group : unit Cmd.t diff --git a/bin/targets_cmd.ml b/bin/show/targets_cmd.ml similarity index 62% rename from bin/targets_cmd.ml rename to bin/show/targets_cmd.ml index 4d6488d500a1..44a0917240ab 100644 --- a/bin/targets_cmd.ml +++ b/bin/show/targets_cmd.ml @@ -3,7 +3,7 @@ open Stdune let doc = "Print available targets in a given directory. Works similalry to ls." -let pp_all_direct_targets ~(contexts : Context.t list) ~show_aliases path = +let pp_all_direct_targets path = let dir = Path.of_string path in let root = match (dir : Path.t) with @@ -17,7 +17,7 @@ let pp_all_direct_targets ~(contexts : Context.t list) ~show_aliases path = | None -> Path.Source.root) in let open Action_builder.O in - let* targets = + let+ targets = let open Memo.O in Action_builder.of_memo (Target.all_direct_targets (Some root) >>| Path.Build.Map.to_list) @@ -43,52 +43,18 @@ let pp_all_direct_targets ~(contexts : Context.t list) ~show_aliases path = | Directory -> Path.basename path ^ Filename.dir_sep) else None) in - let+ alias_targets = - let+ load_dir = - Action_builder.all - @@ List.map contexts ~f:(fun ctx -> - let dir = - Path.build - @@ Path.Build.append_source - (Dune_engine.Context_name.build_dir (Context.name ctx)) - root - 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.union - ~f:(fun _ a _ -> Some a) - acc build.aliases - | _ -> acc) - |> Dune_engine.Alias.Name.Map.to_list_map ~f:(fun name _ -> - Dune_engine.Alias.Name.to_string name) - in [ Pp.textf "%s:" (Path.to_string dir) ; Pp.concat_map targets ~f:Pp.text ~sep:Pp.newline - ; (if show_aliases then - Pp.concat_map alias_targets - ~f:(fun alias -> Pp.text ("@" ^ alias)) - ~sep:Pp.newline - else Pp.nop) ] |> Pp.concat ~sep:Pp.newline let term = let+ common = Common.term - and+ paths = Arg.(value & pos_all string [ "." ] & info [] ~docv:"DIR") - and+ show_aliases = - Arg.(value & flag & info [ "aliases" ] ~doc:"Show aliases") - in + and+ paths = Arg.(value & pos_all string [ "." ] & info [] ~docv:"DIR") in let config = Common.init common in - let request (setup : Dune_rules.Main.build_system) = + let request _ = let open Action_builder.O in - let+ paragraphs = - Action_builder.List.map paths - ~f:(pp_all_direct_targets ~contexts:setup.contexts ~show_aliases) - in + let+ paragraphs = Action_builder.List.map paths ~f:pp_all_direct_targets in paragraphs |> Pp.concat ~sep:(Pp.seq Pp.newline Pp.newline) |> List.singleton |> User_message.make |> User_message.print diff --git a/bin/targets_cmd.mli b/bin/show/targets_cmd.mli similarity index 100% rename from bin/targets_cmd.mli rename to bin/show/targets_cmd.mli diff --git a/test/blackbox-tests/test-cases/show/dune-aliases.t/dune-project b/test/blackbox-tests/test-cases/show/dune-aliases.t/dune-project new file mode 100644 index 000000000000..0ececa7d7fff --- /dev/null +++ b/test/blackbox-tests/test-cases/show/dune-aliases.t/dune-project @@ -0,0 +1 @@ +(lang dune 3.8) diff --git a/test/blackbox-tests/test-cases/show/dune-aliases.t/run.t b/test/blackbox-tests/test-cases/show/dune-aliases.t/run.t new file mode 100644 index 000000000000..6f8fbe5659d3 --- /dev/null +++ b/test/blackbox-tests/test-cases/show/dune-aliases.t/run.t @@ -0,0 +1,113 @@ +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 + 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 diff --git a/test/blackbox-tests/test-cases/targets/dune-targets-simple.t/a.ml b/test/blackbox-tests/test-cases/show/dune-targets-simple.t/a.ml similarity index 100% rename from test/blackbox-tests/test-cases/targets/dune-targets-simple.t/a.ml rename to test/blackbox-tests/test-cases/show/dune-targets-simple.t/a.ml diff --git a/test/blackbox-tests/test-cases/targets/dune-targets-simple.t/b/c.ml b/test/blackbox-tests/test-cases/show/dune-targets-simple.t/b/c.ml similarity index 100% rename from test/blackbox-tests/test-cases/targets/dune-targets-simple.t/b/c.ml rename to test/blackbox-tests/test-cases/show/dune-targets-simple.t/b/c.ml diff --git a/test/blackbox-tests/test-cases/targets/dune-targets-simple.t/b/dune b/test/blackbox-tests/test-cases/show/dune-targets-simple.t/b/dune similarity index 100% rename from test/blackbox-tests/test-cases/targets/dune-targets-simple.t/b/dune rename to test/blackbox-tests/test-cases/show/dune-targets-simple.t/b/dune diff --git a/test/blackbox-tests/test-cases/targets/dune-targets-simple.t/dune b/test/blackbox-tests/test-cases/show/dune-targets-simple.t/dune similarity index 100% rename from test/blackbox-tests/test-cases/targets/dune-targets-simple.t/dune rename to test/blackbox-tests/test-cases/show/dune-targets-simple.t/dune diff --git a/test/blackbox-tests/test-cases/targets/dune-targets-simple.t/dune-project b/test/blackbox-tests/test-cases/show/dune-targets-simple.t/dune-project similarity index 100% rename from test/blackbox-tests/test-cases/targets/dune-targets-simple.t/dune-project rename to test/blackbox-tests/test-cases/show/dune-targets-simple.t/dune-project diff --git a/test/blackbox-tests/test-cases/targets/dune-targets-simple.t/run.t b/test/blackbox-tests/test-cases/show/dune-targets-simple.t/run.t similarity index 67% rename from test/blackbox-tests/test-cases/targets/dune-targets-simple.t/run.t rename to test/blackbox-tests/test-cases/show/dune-targets-simple.t/run.t index 928182520897..d1601f0ff127 100644 --- a/test/blackbox-tests/test-cases/targets/dune-targets-simple.t/run.t +++ b/test/blackbox-tests/test-cases/show/dune-targets-simple.t/run.t @@ -1,5 +1,5 @@ -Testing the "dune targets" command in a simple OCaml project with an additional -directory target to see the behaviour there. +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. @@ -7,7 +7,7 @@ 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 targets + $ dune show targets .: a.ml d/ @@ -18,12 +18,11 @@ working directory. 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 targets . b/ + $ dune show targets . b/ .: a.ml d/ @@ -35,7 +34,6 @@ used, and only the targets available in that directory will be displayed. simple.cmxs simple.ml-gen - b: c.ml dune @@ -44,11 +42,10 @@ used, and only the targets available in that directory will be displayed. simple2.cmxa simple2.cmxs simple2.ml-gen - The command also works with files in the _build directory. - $ dune targets _build/default/ + $ dune show targets _build/default/ _build/default: a.ml d/ @@ -59,9 +56,8 @@ The command also works with files in the _build directory. simple.cmxa simple.cmxs simple.ml-gen - - $ dune targets _build/default/b + $ dune show targets _build/default/b _build/default/b: c.ml dune @@ -70,28 +66,8 @@ The command also works with files in the _build directory. simple2.cmxa simple2.cmxs simple2.ml-gen - We cannot see inside directory targets - $ dune targets d + $ dune show targets d d: - -Testing the --aliases command too: - - $ dune targets --aliases - .: - a.ml - d/ - dune - dune-project - simple.a - simple.cma - simple.cmxa - simple.cmxs - simple.ml-gen - @all - @check - @default - @doc-private - @fmt