unikernel/duniverse/dune_/bin/describe/aliases_targets.ml

@@ -0,0 +1,141 @@
+open Import
+
+let ls_term (fetch_results : Path.Build.t -> string list Action_builder.t) =
+  let+ builder = Common.Builder.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 common, config = Common.init builder 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
+          Source_tree.find_dir src_dir
+          >>= function
+          | 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.space ]
+        |> Pp.concat ~sep:Pp.space)
+    in
+    Console.print
+      [ Pp.vbox @@ Pp.concat_map ~f:Pp.vbox paragraphs ~sep:(Pp.seq Pp.space Pp.space) ]
+  in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  let open Fiber.O in
+  Build.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 similarly 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 separator
+        *)
+        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 similarly to ls." in
+    Cmd.v (Cmd.info "targets" ~doc ~envs:Common.envs) term
+  ;;
+end

unikernel/duniverse/dune_/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 directory. *)
+  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 directory. *)
+  val command : unit Cmd.t
+end

unikernel/duniverse/dune_/bin/describe/describe.ml

@@ -0,0 +1,56 @@
+open Import
+
+(* This command is not yet versioned, but some people are using it in
+   non-released tools. If you change the format of the output, please contact:
+
+   - rotor people for "describe workspace"
+
+   - duniverse people for "describe opam-files" *)
+
+let subcommands =
+  [ Describe_workspace.command
+  ; Describe_external_lib_deps.command
+  ; Describe_opam_files.command
+  ; Describe_pp.command
+  ; Printenv.command
+  ; Print_rules.command
+  ; Installed_libraries.command
+  ; Aliases_targets.Targets_cmd.command
+  ; Aliases_targets.Aliases_cmd.command
+  ; Package_entries.command
+  ; Describe_pkg.command
+  ; Describe_contexts.command
+  ; Describe_depexts.command
+  ; Describe_location.command
+  ]
+;;
+
+let group =
+  let doc = "Describe the workspace." in
+  let man =
+    [ `S "DESCRIPTION"
+    ; `P
+        {|Describe what is in the current workspace in either human or
+        machine readable form.
+
+        By default, this command output a human readable description of
+        the current workspace. This output is aimed at human and is not
+        suitable for machine processing. In particular, it is not versioned.
+
+        If you want to interpret the output of this command from a program,
+        you must use the $(b,--format) option to specify a machine readable
+        format as well as the $(b,--lang) option to get a stable output.|}
+    ; `Blocks Common.help_secs
+    ]
+  in
+  let info = Cmd.info "describe" ~doc ~man in
+  let default = Describe_workspace.term in
+  Cmd.group ~default info subcommands
+;;
+
+module Show = struct
+  let group =
+    let doc = "Command group for showing information about the workspace" in
+    Cmd.group (Cmd.info ~doc "show") subcommands
+  ;;
+end

unikernel/duniverse/dune_/bin/describe/describe.mli

@@ -0,0 +1,9 @@
+open Import
+
+(** Command group for dune describe *)
+val group : unit Cmd.t
+
+module Show : sig
+  (** Command group for dune show (alias of describe) *)
+  val group : unit Cmd.t
+end

unikernel/duniverse/dune_/bin/describe/describe_contexts.ml

@@ -0,0 +1,23 @@
+open Import
+
+let term =
+  let+ builder = Common.Builder.term in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  let open Fiber.O in
+  let* setup = Import.Main.setup () in
+  let+ setup = Memo.run setup in
+  let ctxts =
+    List.map
+      ~f:(fun (name, _) -> Context_name.to_string name)
+      (Context_name.Map.to_list setup.scontexts)
+  in
+  List.iter ctxts ~f:print_endline
+;;
+
+let command =
+  let doc = "List the build contexts available in the workspace." in
+  let info = Cmd.info ~doc "contexts" in
+  Cmd.v info term
+;;

unikernel/duniverse/dune_/bin/describe/describe_contexts.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Dune command to print out the available build contexts.*)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/describe_depexts.ml

@@ -0,0 +1,24 @@
+open Import
+
+let print_depexts context_name =
+  let open Fiber.O in
+  let+ depexts =
+    build_exn (fun () -> Dune_rules.Pkg_rules.all_filtered_depexts context_name)
+  in
+  Console.print [ Pp.concat_map ~sep:Pp.newline ~f:Pp.verbatim depexts ]
+;;
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ context_name = Common.context_arg ~doc:"Build context to use." in
+  let builder = Common.Builder.forbid_builds builder in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config (fun () -> print_depexts context_name)
+;;
+
+let info =
+  let doc = "Print the list of all the available depexts" in
+  Cmd.info "depexts" ~doc
+;;
+
+let command = Cmd.v info term

unikernel/duniverse/dune_/bin/describe/describe_depexts.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Command to print all depexts *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.ml

@@ -0,0 +1,234 @@
+open Import
+module Lib_dep = Dune_lang.Lib_dep
+
+module Kind = struct
+  type t =
+    | Required
+    | Optional
+
+  let to_dyn : t -> Dyn.t = function
+    | Required -> String "required"
+    | Optional -> String "optional"
+  ;;
+end
+
+type lib_dep =
+  { name : Lib_name.t
+  ; kind : Kind.t
+  }
+
+let lib_dep_to_dyn t =
+  let open Dyn in
+  List [ String (Lib_name.to_string t.name); Kind.to_dyn t.kind ]
+;;
+
+module Item = struct
+  module Kind = struct
+    type t =
+      | Executables
+      | Library
+      | Tests
+
+    let to_string = function
+      | Executables -> "executables"
+      | Library -> "library"
+      | Tests -> "tests"
+    ;;
+  end
+
+  type t =
+    { kind : Kind.t
+    ; dir : Path.Source.t
+    ; external_deps : lib_dep list
+    ; internal_deps : lib_dep list
+    ; names : string list
+    ; package : Package.t option
+    ; extensions : string list
+    }
+
+  let to_dyn { kind; dir; external_deps; internal_deps; names; package; extensions } =
+    let open Dyn in
+    let record =
+      record
+        [ "names", (list string) names
+        ; "extensions", (list string) extensions
+        ; "package", option Package.Name.to_dyn (Option.map ~f:Package.name package)
+        ; "source_dir", String (Path.Source.to_string dir)
+        ; "external_deps", list lib_dep_to_dyn external_deps
+        ; "internal_deps", list lib_dep_to_dyn internal_deps
+        ]
+    in
+    Variant (Kind.to_string kind, [ record ])
+  ;;
+end
+
+type dep =
+  | Local of lib_dep
+  | External of lib_dep
+
+let is_external db name =
+  let open Memo.O in
+  let+ lib = Dune_rules.Lib.DB.find_even_when_hidden db name in
+  match lib with
+  | None -> true
+  | Some t ->
+    (match Dune_rules.Lib_info.status (Dune_rules.Lib.info t) with
+     | Installed_private | Public _ | Private _ -> false
+     | Installed -> true)
+;;
+
+let resolve_lib db name kind =
+  let open Memo.O in
+  let+ is_external = is_external db name in
+  if is_external then External { name; kind } else Local { name; kind }
+;;
+
+let resolve_lib_pps db preprocess =
+  let open Memo.O in
+  Dune_rules.Instrumentation.with_instrumentation
+    preprocess
+    ~instrumentation_backend:(Dune_rules.Lib.DB.instrumentation_backend db)
+  |> Resolve.Memo.read_memo
+  >>| Dune_lang.Preprocess.Per_module.pps
+  >>= Memo.parallel_map ~f:(fun (_, name) -> resolve_lib db name Kind.Required)
+;;
+
+let resolve_lib_deps db lib_deps =
+  let open Memo.O in
+  Memo.parallel_map lib_deps ~f:(fun (lib : Lib_dep.t) ->
+    match lib with
+    | Direct (_, name) | Re_export (_, name) ->
+      let+ v = resolve_lib db name Kind.Required in
+      [ v ]
+    | Select select ->
+      select.choices
+      |> Memo.parallel_map ~f:(fun (choice : Lib_dep.Select.Choice.t) ->
+        Lib_name.Set.to_string_list choice.required
+        @ Lib_name.Set.to_string_list choice.forbidden
+        |> Memo.parallel_map ~f:(fun name ->
+          let name = Lib_name.of_string name in
+          resolve_lib db name Kind.Optional))
+      >>| List.concat)
+  >>| List.concat
+;;
+
+let resolve_libs db dir libraries preprocess names package kind extensions =
+  let open Memo.O in
+  let open Item in
+  let* lib_deps = resolve_lib_deps db libraries in
+  let+ lib_pps = resolve_lib_pps db preprocess in
+  let deps = lib_deps @ lib_pps in
+  let internal_deps, external_deps =
+    deps
+    |> List.partition_map ~f:(function
+      | Local lib -> Either.Left lib
+      | External lib -> Either.Right lib)
+  in
+  { external_deps; internal_deps; kind; names; package; dir; extensions }
+;;
+
+let exes_extensions (lib_config : Dune_rules.Lib_config.t) modes =
+  Dune_rules.Executables.Link_mode.Map.to_list modes
+  |> List.map ~f:(fun (m, loc) ->
+    Dune_rules.Executables.Link_mode.extension
+      m
+      ~loc
+      ~ext_obj:lib_config.ext_obj
+      ~ext_dll:lib_config.ext_dll)
+;;
+
+let libs db (context : Context.t) =
+  let open Memo.O in
+  let* dune_files = Context.name context |> Dune_rules.Dune_load.dune_files in
+  Memo.parallel_map dune_files ~f:(fun (dune_file : Dune_rules.Dune_file.t) ->
+    Dune_file.stanzas dune_file
+    >>= Memo.parallel_map ~f:(fun stanza ->
+      let dir = Dune_file.dir dune_file in
+      match Stanza.repr stanza with
+      | Dune_rules.Executables.T exes ->
+        let* ocaml = Context.ocaml context in
+        resolve_libs
+          db
+          dir
+          exes.buildable.libraries
+          exes.buildable.preprocess
+          (List.map (Nonempty_list.to_list exes.names) ~f:snd)
+          exes.package
+          Item.Kind.Executables
+          (exes_extensions ocaml.lib_config exes.modes)
+        >>| List.singleton
+      | Dune_rules.Library.T lib ->
+        resolve_libs
+          db
+          dir
+          lib.buildable.libraries
+          lib.buildable.preprocess
+          [ Dune_rules.Library.best_name lib |> Lib_name.to_string ]
+          (Dune_rules.Library.package lib)
+          Item.Kind.Library
+          []
+        >>| List.singleton
+      | Dune_rules.Tests.T tests ->
+        let* ocaml = Context.ocaml context in
+        resolve_libs
+          db
+          dir
+          tests.exes.buildable.libraries
+          tests.exes.buildable.preprocess
+          (List.map (Nonempty_list.to_list tests.exes.names) ~f:snd)
+          (if Option.is_none tests.package then tests.exes.package else tests.package)
+          Item.Kind.Tests
+          (exes_extensions ocaml.lib_config tests.exes.modes)
+        >>| List.singleton
+      | _ -> Memo.return [])
+    >>| List.concat)
+  >>| List.concat
+;;
+
+let external_resolved_libs (context : Context.t) =
+  let open Memo.O in
+  let* scope = Dune_rules.Scope.DB.find_by_dir (Context.build_dir context) in
+  let db = Dune_rules.Scope.libs scope in
+  libs db context
+  >>| List.filter ~f:(fun (x : Item.t) ->
+    not (List.is_empty x.external_deps && List.is_empty x.internal_deps))
+;;
+
+let to_dyn context_name external_resolved_libs =
+  let open Dyn in
+  Tuple [ String context_name; list Item.to_dyn external_resolved_libs ]
+;;
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ context_name = Common.context_arg ~doc:"Build context to use."
+  and+ _ = Describe_lang_compat.arg
+  and+ format = Describe_format.arg in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  let open Fiber.O in
+  let* setup = Import.Main.setup () in
+  let* setup = Memo.run setup in
+  let super_context = Import.Main.find_scontext_exn setup ~name:context_name in
+  build_exn
+  @@ fun () ->
+  let open Memo.O in
+  let context_name =
+    Super_context.context super_context
+    |> Context.name
+    |> Dune_engine.Context_name.to_string
+  in
+  external_resolved_libs (Super_context.context super_context)
+  >>| to_dyn context_name
+  >>| Describe_format.print_dyn format
+;;
+
+let command =
+  let doc =
+    "Print out external libraries needed to build the project. It's an approximated set \
+     of libraries."
+  in
+  let info = Cmd.info ~doc "external-lib-deps" in
+  Cmd.v info term
+;;

unikernel/duniverse/dune_/bin/describe/describe_external_lib_deps.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Dune command to describe the external library dependencies *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/describe_format.ml

@@ -0,0 +1,34 @@
+open Import
+
+type t =
+  | Sexp
+  | Csexp
+
+let all = [ "sexp", Sexp; "csexp", Csexp ]
+
+let arg =
+  let doc = Printf.sprintf "$(docv) must be %s" (Arg.doc_alts_enum all) in
+  Arg.(value & opt (enum all) Sexp & info [ "format" ] ~docv:"FORMAT" ~doc)
+;;
+
+let print_as_sexp dyn =
+  let rec dune_lang_of_sexp : Sexp.t -> Dune_lang.t = function
+    | Atom s -> Dune_lang.atom_or_quoted_string s
+    | List l -> List (List.map l ~f:dune_lang_of_sexp)
+  in
+  let cst =
+    dyn
+    |> Sexp.of_dyn
+    |> dune_lang_of_sexp
+    |> Dune_lang.Ast.add_loc ~loc:Loc.none
+    |> Dune_lang.Cst.concrete
+  in
+  let version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in
+  Pp.to_fmt Stdlib.Format.std_formatter (Dune_lang.Format.pp_top_sexps ~version [ cst ])
+;;
+
+let print_dyn t dyn =
+  match t with
+  | Csexp -> Csexp.to_channel stdout (Sexp.of_dyn dyn)
+  | Sexp -> print_as_sexp dyn
+;;

unikernel/duniverse/dune_/bin/describe/describe_format.mli

@@ -0,0 +1,13 @@
+open Import
+
+(** Formatting utilities for dune describe commands *)
+
+type t =
+  | Sexp
+  | Csexp
+
+(** Command line option for taking a serialisation format *)
+val arg : t Term.t
+
+(** [print_dyn t dyn] prints the dyn to stdout serialised as configured in [t] *)
+val print_dyn : t -> Dyn.t -> unit

unikernel/duniverse/dune_/bin/describe/describe_lang_compat.ml

@@ -0,0 +1,11 @@
+let arg =
+  Arg.(
+    value
+    & opt (some string) None
+    & info
+        [ "lang" ]
+        ~docv:"VERSION"
+        ~doc:
+          "This argument has no effect and is deprecated. It exists solely for backwards \
+           compatibility.")
+;;

unikernel/duniverse/dune_/bin/describe/describe_lang_compat.mli

@@ -0,0 +1,5 @@
+(** Dune describe commands used to take a --lang argument that did nothing
+    expect for dune describe workspace. To keep compatilbility with accepting
+    such an argument we provide a dummy argument here that can be used. It's
+    value will typically be ignored. *)
+val arg : string option Cmdliner.Term.t

unikernel/duniverse/dune_/bin/describe/describe_location.ml

@@ -0,0 +1,43 @@
+open! Import
+
+let doc =
+  "Print the path to the executable using the same resolution logic as [dune exec]."
+;;
+
+let man =
+  [ `S "DESCRIPTION"
+  ; `P
+      {|$(b,dune describe location NAME) prints the path to the executable NAME using the same logic as:
+          |}
+  ; `Pre "$ dune exec NAME"
+  ; `P
+      "Dune will first try to resolve the executable within the public executables in \
+       the current project, then inside the \"bin\" directory of each package among the \
+       project's  dependencies (when using dune package management), and finally within \
+       the  directories listed in the $PATH environment variable."
+  ]
+;;
+
+let info = Cmd.info "location" ~doc ~man
+
+let term : unit Term.t =
+  let+ builder = Common.Builder.term
+  and+ context = Common.context_arg ~doc:{|Run the command in this build context.|}
+  and+ prog =
+    Arg.(required & pos 0 (some Exec.Cmd_arg.conv) None (Arg.info [] ~docv:"PROG"))
+  in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  let open Fiber.O in
+  let* setup = Import.Main.setup () in
+  build_exn
+  @@ fun () ->
+  let open Memo.O in
+  let* sctx = setup >>| Import.Main.find_scontext_exn ~name:context in
+  let* prog = Exec.Cmd_arg.expand ~root:(Common.root common) ~sctx prog in
+  let+ path = Exec.get_path common sctx ~prog >>| Path.to_string in
+  Dune_console.printf "%s" path
+;;
+
+let command = Cmd.v info term

unikernel/duniverse/dune_/bin/describe/describe_location.mli

@@ -0,0 +1,3 @@
+open! Import
+
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/describe_opam_files.ml

@@ -0,0 +1,38 @@
+open Import
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ format = Describe_format.arg
+  and+ _ = Describe_lang_compat.arg in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  build_exn
+  @@ fun () ->
+  let open Memo.O in
+  let+ project = Source_tree.root () >>| Source_tree.Dir.project in
+  let packages = Dune_project.packages project |> Package.Name.Map.values in
+  let opam_file_to_dyn pkg =
+    let opam_file = Path.source (Package.opam_file pkg) in
+    let contents =
+      if Dune_project.generate_opam_files project
+      then (
+        let template_file = Dune_rules.Opam_create.template_file opam_file in
+        let template =
+          if Path.exists template_file
+          then Some (template_file, Io.read_file template_file)
+          else None
+        in
+        Dune_rules.Opam_create.generate project pkg ~template)
+      else Io.read_file opam_file
+    in
+    Dyn.Tuple [ String (Path.to_string opam_file); String contents ]
+  in
+  packages |> Dyn.list opam_file_to_dyn |> Describe_format.print_dyn format
+;;
+
+let command =
+  let doc = "Print information about the opam files that have been discovered." in
+  let info = Cmd.info ~doc "opam-files" in
+  Cmd.v info term
+;;

unikernel/duniverse/dune_/bin/describe/describe_opam_files.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Dune command to describe the opam files in a workspace *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/describe_pkg.ml

@@ -0,0 +1,200 @@
+open Import
+module Lock_dir = Dune_pkg.Lock_dir
+module Local_package = Dune_pkg.Local_package
+
+module Show_lock = struct
+  let print_lock lock_dir_arg () =
+    let open Fiber.O in
+    let* lock_dir_paths =
+      Memo.run (Workspace.workspace ())
+      >>| Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dir_arg
+    in
+    Fiber.parallel_map lock_dir_paths ~f:(fun lock_dir_path ->
+      let+ platform = Pkg_common.solver_env_from_system_and_context ~lock_dir_path in
+      let lock_dir = Lock_dir.read_disk_exn lock_dir_path in
+      let packages =
+        Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform
+        |> Package_name.Map.values
+      in
+      Pp.concat
+        ~sep:Pp.space
+        [ Pp.hovbox
+          @@ Pp.textf "Contents of %s:" (Path.Source.to_string_maybe_quoted lock_dir_path)
+        ; Pkg_common.pp_packages packages
+        ]
+      |> Pp.vbox)
+    >>| Console.print
+  ;;
+
+  let term =
+    let+ builder = Common.Builder.term
+    and+ lock_dir_arg = Pkg_common.Lock_dirs_arg.term in
+    let builder = Common.Builder.forbid_builds builder in
+    let common, config = Common.init builder in
+    Scheduler.go_with_rpc_server ~common ~config @@ print_lock lock_dir_arg
+  ;;
+
+  let command =
+    let doc = "Display packages in a lock file" in
+    let info = Cmd.info ~doc "lock" in
+    Cmd.v info term
+  ;;
+end
+
+module Dependency_hash = struct
+  let print_local_packages_hash () =
+    let open Fiber.O in
+    let+ local_packages =
+      Pkg_common.find_local_packages
+      |> Memo.run
+      >>| Package_name.Map.values
+      >>| List.map ~f:Local_package.for_solver
+    in
+    let hash =
+      Local_package.For_solver.non_local_dependencies local_packages
+      |> Local_package.Dependency_hash.of_dependency_formula
+    in
+    match hash with
+    | None -> User_error.raise [ Pp.text "No non-local dependencies" ]
+    | Some dependency_hash ->
+      print_endline (Local_package.Dependency_hash.to_string dependency_hash)
+  ;;
+
+  let term =
+    let+ builder = Common.Builder.term in
+    let builder = Common.Builder.forbid_builds builder in
+    let common, config = Common.init builder in
+    Scheduler.go_with_rpc_server ~common ~config print_local_packages_hash
+  ;;
+
+  let info =
+    let doc =
+      "Print the hash of the project's non-local dependencies such as what would appear \
+       in the \"dependency_hash\" field of a a lock.dune file."
+    in
+    Cmd.info "dependency-hash" ~doc
+  ;;
+
+  let command = Cmd.v info term
+end
+
+module List_locked_dependencies = struct
+  module Package_universe = Dune_pkg.Package_universe
+  module Lock_dir = Dune_pkg.Lock_dir
+  module Opam_repo = Dune_pkg.Opam_repo
+  module Package_version = Dune_pkg.Package_version
+  module Opam_solver = Dune_pkg.Opam_solver
+
+  let info =
+    let doc = "List the dependencies locked by a lockdir" in
+    let man = [ `S "DESCRIPTION"; `P "List the dependencies locked by a lockdir" ] in
+    Cmd.info "list-locked-dependencies" ~doc ~man
+  ;;
+
+  let package_deps_in_lock_dir_pp package_universe package_name ~transitive =
+    let traverse, traverse_word =
+      if transitive then `Transitive, "Transitive" else `Immediate, "Immediate"
+    in
+    let opam_package =
+      Package_universe.opam_package_of_package package_universe package_name
+    in
+    let list_dependencies which =
+      Package_universe.opam_package_dependencies_of_package
+        package_universe
+        package_name
+        ~which
+        ~traverse
+    in
+    Pp.concat
+      ~sep:Pp.cut
+      [ Pp.hbox
+          (Pp.textf
+             "%s dependencies of local package %s"
+             traverse_word
+             (OpamPackage.to_string opam_package))
+      ; Pp.enumerate (list_dependencies `Non_test) ~f:(fun opam_package ->
+          Pp.text (OpamPackage.to_string opam_package))
+      ; Pp.enumerate (list_dependencies `Test_only) ~f:(fun opam_package ->
+          Pp.textf "%s (test only)" (OpamPackage.to_string opam_package))
+      ]
+    |> Pp.vbox
+  ;;
+
+  let enumerate_lock_dirs_by_path workspace ~lock_dirs =
+    let lock_dirs = Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs workspace in
+    List.filter_map lock_dirs ~f:(fun lock_dir_path ->
+      if Path.exists (Path.source lock_dir_path)
+      then (
+        try Some (lock_dir_path, Lock_dir.read_disk_exn lock_dir_path) with
+        | User_error.E e ->
+          User_warning.emit
+            [ Pp.textf
+                "Failed to parse lockdir %s:"
+                (Path.Source.to_string_maybe_quoted lock_dir_path)
+            ; User_message.pp e
+            ];
+          None)
+      else None)
+  ;;
+
+  let list_locked_dependencies ~transitive ~lock_dirs () =
+    let open Fiber.O in
+    let* lock_dirs_by_path, local_packages =
+      let open Memo.O in
+      Memo.both
+        (Workspace.workspace () >>| enumerate_lock_dirs_by_path ~lock_dirs)
+        Pkg_common.find_local_packages
+      |> Memo.run
+    in
+    let+ pp =
+      Fiber.parallel_map lock_dirs_by_path ~f:(fun (lock_dir_path, lock_dir) ->
+        let+ platform = Pkg_common.solver_env_from_system_and_context ~lock_dir_path in
+        let package_universe =
+          Package_universe.create ~platform local_packages lock_dir |> User_error.ok_exn
+        in
+        Pp.vbox
+          (Pp.concat
+             ~sep:Pp.cut
+             [ Pp.hbox
+                 (Pp.textf
+                    "Dependencies of local packages locked in %s"
+                    (Path.Source.to_string_maybe_quoted lock_dir_path))
+             ; Pp.enumerate
+                 (Package_name.Map.keys local_packages)
+                 ~f:(package_deps_in_lock_dir_pp package_universe ~transitive)
+               |> Pp.box
+             ]))
+      >>| Pp.concat ~sep:Pp.cut
+      >>| Pp.vbox
+    in
+    Console.print [ pp ]
+  ;;
+
+  let term =
+    let+ builder = Common.Builder.term
+    and+ transitive =
+      Arg.(
+        value
+        & flag
+        & info
+            [ "transitive" ]
+            ~doc:
+              "Display transitive dependencies (by default only immediate dependencies \
+               are displayed)")
+    and+ lock_dirs = Pkg_common.Lock_dirs_arg.term in
+    let builder = Common.Builder.forbid_builds builder in
+    let common, config = Common.init builder in
+    Scheduler.go_with_rpc_server ~common ~config
+    @@ list_locked_dependencies ~transitive ~lock_dirs
+  ;;
+
+  let command = Cmd.v info term
+end
+
+let command =
+  let doc = "Subcommands related to package management" in
+  let info = Cmd.info ~doc "pkg" in
+  Cmd.group
+    info
+    [ Show_lock.command; List_locked_dependencies.command; Dependency_hash.command ]
+;;

unikernel/duniverse/dune_/bin/describe/describe_pkg.mli

@@ -0,0 +1,3 @@
+open Import
+
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/describe_pp.ml

@@ -0,0 +1,183 @@
+open Import
+module Dialect = Dune_lang.Dialect
+
+let dialect_and_ml_kind file =
+  let open Memo.O in
+  let _base, ext =
+    let file = Path.of_string file in
+    Path.split_extension file
+  in
+  let+ project = Source_tree.root () >>| Source_tree.Dir.project in
+  let dialects = Dune_project.dialects project in
+  match Dialect.DB.find_by_extension dialects ext with
+  | None -> User_error.raise [ Pp.textf "unsupported extension: %s" ext ]
+  | Some x -> x
+;;
+
+let execute_pp_action ~sctx file pp_file dump_file =
+  let open Memo.O in
+  let* expander =
+    let bindings =
+      Dune_lang.Pform.Map.singleton
+        (Var Input_file)
+        [ Dune_lang.Value.Path (Path.build (pp_file |> Path.as_in_build_dir_exn)) ]
+    in
+    let dir = pp_file |> Path.parent_exn |> Path.as_in_build_dir_exn in
+    Super_context.expander sctx ~dir >>| Dune_rules.Expander.add_bindings ~bindings
+  in
+  let context = Dune_rules.Expander.context expander in
+  let build_dir = Context_name.build_dir context in
+  let* input =
+    let* action, _observing_facts =
+      let* loc, action =
+        let+ dialect, ml_kind = dialect_and_ml_kind file in
+        match Dialect.print_ast dialect ml_kind with
+        | Some print_ast -> print_ast
+        | None ->
+          (* fall back to the OCaml print_ast function, known to exist, if one
+             doesn't exist for this dialect. *)
+          Dialect.print_ast Dialect.ocaml ml_kind |> Option.value_exn
+      in
+      let build =
+        let open Action_builder.O in
+        let+ build =
+          Dune_rules.For_tests.Action_unexpanded.expand_no_targets
+            action
+            ~chdir:build_dir
+            ~loc
+            ~expander
+            ~deps:[]
+            ~what:"describe pp"
+        in
+        Action.with_outputs_to dump_file build.action
+      in
+      Action_builder.evaluate_and_collect_facts build
+    in
+    let+ env = Dune_rules.Super_context.context_env sctx
+    and+ execution_parameters = Dune_engine.Execution_parameters.default in
+    let targets =
+      let unvalidated = Targets.File.create dump_file in
+      match Targets.validate unvalidated with
+      | Valid targets -> targets
+      | No_targets
+      | Inconsistent_parent_dir
+      | File_and_directory_target_with_the_same_name _ -> assert false
+    in
+    { Dune_engine.Action_exec.targets = Some targets
+    ; root = Path.build build_dir
+    ; context = Some (Dune_engine.Build_context.create ~name:context)
+    ; env
+    ; rule_loc = Loc.none
+    ; execution_parameters
+    ; action
+    }
+  in
+  let ok =
+    let open Fiber.O in
+    let build_deps deps = Build_system.build_deps deps |> Memo.run in
+    let* result = Dune_engine.Action_exec.exec input ~build_deps in
+    Dune_engine.Action_exec.Exec_result.ok_exn result >>| ignore
+  in
+  Memo.of_non_reproducible_fiber ok
+;;
+
+let print_pped_file =
+  let dump_file pp_file ~ml_kind =
+    Path.set_extension
+      pp_file
+      ~ext:
+        (match (ml_kind : Ocaml.Ml_kind.t) with
+         | Intf -> ".cmi.dump"
+         | Impl -> ".cmo.dump")
+    |> Path.as_in_build_dir_exn
+  in
+  fun ~sctx file pp_file ~ml_kind ->
+    let open Memo.O in
+    let dump_file = dump_file pp_file ~ml_kind in
+    let+ () = execute_pp_action ~sctx file pp_file dump_file in
+    let dump_file = Path.build dump_file in
+    match Path.stat dump_file with
+    | Ok { st_kind = S_REG; _ } ->
+      Io.cat dump_file;
+      Path.unlink_no_err dump_file
+    | _ ->
+      User_error.raise
+        [ Pp.textf "cannot find a dump file: %s" (Path.to_string dump_file) ]
+;;
+
+let find_module ~sctx file =
+  let open Memo.O in
+  let src = Path.drop_optional_build_context_src_exn (Path.build file) in
+  Dune_rules.Top_module.find_module sctx src
+  >>| function
+  | None -> None
+  | Some (m, _, _, origin) ->
+    (match
+       Dune_rules.Ml_sources.Origin.preprocess origin
+       |> Dune_lang.Preprocess.Per_module.find (Dune_rules.Module.name m)
+     with
+     | Pps { staged = true; loc; _ } -> Some (`Staged_pps loc)
+     | _ -> Some (`Module m))
+;;
+
+let get_pped_file super_context file =
+  let open Memo.O in
+  let context = Super_context.context super_context in
+  let in_build_dir file =
+    file |> Path.to_string |> Path.Build.relative (Context.build_dir context)
+  in
+  let file_in_build_dir =
+    if String.is_empty file
+    then User_error.raise [ Pp.textf "No file given." ]
+    else Path.of_string file |> in_build_dir
+  in
+  let* ml_kind =
+    let+ _, ml_kind = dialect_and_ml_kind file in
+    ml_kind
+  in
+  let file_not_found () =
+    User_error.raise
+      [ Pp.textf "%s does not exist" (Path.Build.to_string_maybe_quoted file_in_build_dir)
+      ]
+  in
+  find_module ~sctx:super_context file_in_build_dir
+  >>= function
+  | None -> file_not_found ()
+  | Some (`Module m) ->
+    (match
+       Dune_rules.Module.source m ~ml_kind |> Option.map ~f:Dune_rules.Module.File.path
+     with
+     | None -> file_not_found ()
+     | Some pp_file ->
+       let+ () = Build_system.build_file pp_file in
+       Ok (pp_file, ml_kind))
+  | Some (`Staged_pps loc) ->
+    User_error.raise ~loc [ Pp.text "staged_pps are not supported." ]
+;;
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ context_name = Common.context_arg ~doc:"Build context to use."
+  and+ _ = Describe_lang_compat.arg
+  and+ file = Arg.(required & pos 0 (some string) None (Arg.info [] ~docv:"FILE")) in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  let open Fiber.O in
+  let* setup = Import.Main.setup () in
+  let* setup = Memo.run setup in
+  let sctx = Import.Main.find_scontext_exn setup ~name:context_name in
+  build_exn
+  @@ fun () ->
+  let open Memo.O in
+  let* result = get_pped_file sctx file in
+  match result with
+  | Error file -> Io.cat file |> Memo.return
+  | Ok (pp_file, ml_kind) -> print_pped_file ~sctx file pp_file ~ml_kind
+;;
+
+let command =
+  let doc = "Build a given FILE and print the preprocessed output." in
+  let info = Cmd.info ~doc "pp" in
+  Cmd.v info term
+;;

unikernel/duniverse/dune_/bin/describe/describe_pp.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Dune command to show the preprocessed version of a file. *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/describe_workspace.ml

@@ -0,0 +1,687 @@
+open Import
+
+module Options = struct
+  (* Option flags for what to do while crawling the workspace *)
+  type t =
+    { with_deps : bool (* whether to compute direct dependencies between modules *)
+    ; with_pps : bool
+      (* whether to include the dependencies to ppx-rewriters (that are
+       used at compile time) *)
+    }
+
+  (* whether to sanitize absolute paths of workspace items, and their UIDs, to
+     ensure reproducible tests *)
+  let sanitize_for_tests = ref false
+
+  let arg_with_deps =
+    let open Arg in
+    value
+    & flag
+    & info
+        [ "with-deps" ]
+        ~doc:"Whether the dependencies between modules should be printed."
+  ;;
+
+  let arg_with_pps =
+    let open Arg in
+    value
+    & flag
+    & info
+        [ "with-pps" ]
+        ~doc:
+          "Whether the dependencies towards ppx-rewriters (that are called at compile \
+           time) should be taken into account."
+  ;;
+
+  let arg_sanitize_for_tests =
+    let open Arg in
+    value
+    & flag
+    & info
+        [ "sanitize-for-tests" ]
+        ~doc:
+          "Sanitize the absolute paths in workspace items, and the associated UIDs, so \
+           that the output is reproducible."
+  ;;
+
+  let arg : t Term.t =
+    let+ with_deps = arg_with_deps
+    and+ with_pps = arg_with_pps
+    and+ sanitize_for_tests_value = arg_sanitize_for_tests in
+    sanitize_for_tests := sanitize_for_tests_value;
+    { with_deps; with_pps }
+  ;;
+end
+
+(* The module [Descr] is a typed representation of the description of a
+   workspace, that is provided by the ``dune describe workspace`` command.
+
+   Each sub-module contains a [to_dyn] function, that translates the
+   descriptors to a value of type [Dyn.t].
+
+   The typed representation aims at precisely describing the structure of the
+   information computed by ``dune describe``, and hopefully make users' life
+   easier in decoding the S-expressions into meaningful contents. *)
+module Descr = struct
+  (* [dyn_path p] converts a path to a value of type [Dyn.t]. Remark: this is
+     different from Path.to_dyn, that produces extra tags from a variant
+     datatype. *)
+  let dyn_path (p : Path.t) : Dyn.t = String (Path.to_string p)
+
+  (* Description of the dependencies of a module *)
+  module Mod_deps = struct
+    type t =
+      { for_intf : Dune_rules.Module_name.t list
+        (* direct module dependencies for the interface *)
+      ; for_impl : Dune_rules.Module_name.t list
+        (* direct module dependencies for the implementation *)
+      }
+
+    (* Conversion to the [Dyn.t] type *)
+    let to_dyn { for_intf; for_impl } =
+      let open Dyn in
+      record
+        [ "for_intf", list Dune_rules.Module_name.to_dyn for_intf
+        ; "for_impl", list Dune_rules.Module_name.to_dyn for_impl
+        ]
+    ;;
+  end
+
+  (* Description of modules *)
+  module Mod = struct
+    type t =
+      { name : Dune_rules.Module_name.t (* name of the module *)
+      ; impl : Path.t option (* path to the .ml file, if any *)
+      ; intf : Path.t option (* path to the .mli file, if any *)
+      ; cmt : Path.t option (* path to the .cmt file, if any *)
+      ; cmti : Path.t option (* path to the .cmti file, if any *)
+      ; module_deps : Mod_deps.t (* direct module dependencies *)
+      }
+
+    (* Conversion to the [Dyn.t] type *)
+    let to_dyn { Options.with_deps; _ } { name; impl; intf; cmt; cmti; module_deps }
+      : Dyn.t
+      =
+      let open Dyn in
+      let optional_fields =
+        let module_deps =
+          if with_deps then Some ("module_deps", Mod_deps.to_dyn module_deps) else None
+        in
+        (* we build a list of options, that is later filtered, so that adding
+           new optional fields in the future can be done easily *)
+        match module_deps with
+        | None -> []
+        | Some module_deps -> [ module_deps ]
+      in
+      record
+      @@ [ "name", Dune_rules.Module_name.to_dyn name
+         ; "impl", option dyn_path impl
+         ; "intf", option dyn_path intf
+         ; "cmt", option dyn_path cmt
+         ; "cmti", option dyn_path cmti
+         ]
+      @ optional_fields
+    ;;
+  end
+
+  (* Description of executables *)
+  module Exe = struct
+    type t =
+      { names : string list (* names of the executable *)
+      ; requires : Digest.t list
+        (* list of direct dependencies to libraries, identified by their
+             digests *)
+      ; modules : Mod.t list (* list of the modules the executable is composed of *)
+      ; include_dirs : Path.t list (* list of include directories *)
+      }
+
+    let map_path t ~f = { t with include_dirs = List.map ~f t.include_dirs }
+
+    (* Conversion to the [Dyn.t] type *)
+    let to_dyn options { names; requires; modules; include_dirs } : Dyn.t =
+      let open Dyn in
+      record
+        [ "names", List (List.map ~f:(fun name -> String name) names)
+        ; "requires", Dyn.(list string) (List.map ~f:Digest.to_string requires)
+        ; "modules", list (Mod.to_dyn options) modules
+        ; "include_dirs", list dyn_path include_dirs
+        ]
+    ;;
+  end
+
+  (* Description of libraries *)
+
+  module Lib = struct
+    type t =
+      { name : Lib_name.t (* name of the library *)
+      ; uid : Digest.t (* digest of the library *)
+      ; local : bool (* whether this library is local *)
+      ; requires : Digest.t list
+        (* list of direct dependendies to libraries, identified by their
+             digests *)
+      ; source_dir : Path.t
+        (* path to the directory that contains the sources of this library *)
+      ; modules : Mod.t list (* list of the modules the executable is composed of *)
+      ; include_dirs : Path.t list (* list of include directories *)
+      }
+
+    let map_path t ~f =
+      { t with source_dir = f t.source_dir; include_dirs = List.map ~f t.include_dirs }
+    ;;
+
+    (* Conversion to the [Dyn.t] type *)
+    let to_dyn options { name; uid; local; requires; source_dir; modules; include_dirs }
+      : Dyn.t
+      =
+      let open Dyn in
+      record
+        [ "name", Lib_name.to_dyn name
+        ; "uid", String (Digest.to_string uid)
+        ; "local", Bool local
+        ; "requires", (list string) (List.map ~f:Digest.to_string requires)
+        ; "source_dir", dyn_path source_dir
+        ; "modules", list (Mod.to_dyn options) modules
+        ; "include_dirs", (list dyn_path) include_dirs
+        ]
+    ;;
+  end
+
+  (* Description of items: executables, or libraries *)
+  module Item = struct
+    type t =
+      | Executables of Exe.t
+      | Library of Lib.t
+      | Root of Path.t
+      | Build_context of Path.t
+
+    let map_path t ~f =
+      match t with
+      | Executables exe -> Executables (Exe.map_path exe ~f)
+      | Library lib -> Library (Lib.map_path lib ~f)
+      | Root r -> Root (f r)
+      | Build_context c -> Build_context (f c)
+    ;;
+
+    (* Conversion to the [Dyn.t] type *)
+    let to_dyn options : t -> Dyn.t = function
+      | Executables exe_descr -> Variant ("executables", [ Exe.to_dyn options exe_descr ])
+      | Library lib_descr -> Variant ("library", [ Lib.to_dyn options lib_descr ])
+      | Root root -> Variant ("root", [ String (Path.to_absolute_filename root) ])
+      | Build_context build_ctxt ->
+        Variant ("build_context", [ String (Path.to_string build_ctxt) ])
+    ;;
+  end
+
+  (* Description of a workspace: a list of items *)
+  module Workspace = struct
+    type t = Item.t list
+
+    (* Conversion to the [Dyn.t] type *)
+    let to_dyn options (items : t) : Dyn.t = Dyn.list (Item.to_dyn options) items
+  end
+end
+
+module Lang = struct
+  type t = Dune_lang.Syntax.Version.t
+
+  let arg_conv =
+    let parser s =
+      match Scanf.sscanf s "%u.%u" (fun a b -> a, b) with
+      | Ok t -> Ok t
+      | Error () -> Error (`Msg "Expected version of the form NNN.NNN.")
+    in
+    let printer ppf t =
+      Stdlib.Format.fprintf ppf "%s" (Dune_lang.Syntax.Version.to_string t)
+    in
+    Arg.conv ~docv:"VERSION" (parser, printer)
+  ;;
+
+  let arg : t Term.t =
+    Term.ret
+    @@ let+ v =
+         Arg.(
+           value
+           & opt arg_conv (0, 1)
+           & info
+               [ "lang" ]
+               ~docv:"VERSION"
+               ~doc:"Behave the same as this version of Dune.")
+       in
+       if v = (0, 1)
+       then `Ok v
+       else (
+         let msg =
+           let pp =
+             "Only --lang 0.1 is available at the moment as this command is not yet \
+              stabilised. If you would like to release a software that relies on the \
+              output of 'dune describe', please open a ticket on \
+              https://github.com/ocaml/dune."
+             |> Pp.text
+           in
+           Stdlib.Format.asprintf "%a" Pp.to_fmt pp
+         in
+         `Error (true, msg))
+  ;;
+end
+
+(* The following module is responsible sanitizing the output of
+   [dune describe workspace], so that the absolute paths and the UIDs that
+   depend on them are stable for tests. These paths may differ, depending on
+   the machine they are run on. *)
+module Sanitize_for_tests = struct
+  module Workspace = struct
+    let fake_findlib = lazy (Path.External.of_string "/FINDLIB")
+    let fake_workspace = lazy (Path.External.of_string "/WORKSPACE_ROOT")
+
+    let sanitize_with_findlib ~findlib_paths path =
+      let path = Path.external_ path in
+      List.find_map findlib_paths ~f:(fun candidate ->
+        let open Option.O in
+        let* candidate = Path.as_external candidate in
+        (* if the path to rename is an external path, try to find the
+           OCaml root inside, and replace it with a fixed string *)
+        let+ without_prefix = Path.drop_prefix ~prefix:(Path.external_ candidate) path in
+        (* we have found the OCaml root path: let's replace it with a
+           constant string *)
+        Path.External.append_local (Lazy.force fake_findlib) without_prefix)
+    ;;
+
+    (* Sanitizes a workspace description, by renaming non-reproducible UIDs and
+       paths *)
+    let really_sanitize ~findlib_paths items =
+      let rename_path = function
+        (* we have found a path for OCaml's root: let's define the renaming
+           function *)
+        | Path.External path ->
+          sanitize_with_findlib ~findlib_paths path
+          |> Option.value ~default:path
+          |> Path.external_
+        | In_source_tree p ->
+          (* Replace the workspace root with a fixed string *)
+          Path.External.append_local (Lazy.force fake_workspace) (Path.Source.to_local p)
+          |> Path.external_
+        | path ->
+          (* Otherwise, it should not be changed *)
+          path
+      in
+      (* now, we rename the UIDs in the [requires] field , while reversing the
+         list of items, so that we get back the original ordering *)
+      List.map ~f:(Descr.Item.map_path ~f:rename_path) items
+    ;;
+
+    (* Sanitizes a workspace description when options ask to do so, or performs
+       no change at all otherwise *)
+    let sanitize ~findlib_paths items =
+      if !Options.sanitize_for_tests then really_sanitize ~findlib_paths items else items
+    ;;
+  end
+end
+
+(* Crawl the workspace to get all the data *)
+module Crawl = struct
+  open Dune_rules
+  open Dune_engine
+  open Memo.O
+
+  (* Computes the digest of a library *)
+  let uid_of_library (lib : Lib.t) : Digest.t =
+    let name = Lib.name lib in
+    if Lib.is_local lib
+    then (
+      let source_dir = Lib_info.src_dir (Lib.info lib) in
+      Digest.generic (name, Path.to_string source_dir))
+    else Digest.generic name
+  ;;
+
+  let immediate_deps_of_module ~options ~obj_dir ~modules unit =
+    match (options : Options.t) with
+    | { with_deps = false; _ } ->
+      Action_builder.return { Ocaml.Ml_kind.Dict.intf = []; impl = [] }
+    | { with_deps = true; _ } ->
+      let deps ml_kind =
+        Dune_rules.Dep_rules.immediate_deps_of unit modules ~obj_dir ~ml_kind
+      in
+      let open Action_builder.O in
+      let+ intf, impl = Action_builder.both (deps Intf) (deps Impl) in
+      { Ocaml.Ml_kind.Dict.intf; impl }
+  ;;
+
+  (* Builds the description of a module from a module and its object directory *)
+  let module_
+        ~obj_dir
+        ~(deps_for_intf : Module.t list)
+        ~(deps_for_impl : Module.t list)
+        (m : Module.t)
+    : Descr.Mod.t
+    =
+    let source ml_kind = Option.map (Module.source m ~ml_kind) ~f:Module.File.path in
+    let cmt ml_kind =
+      Dune_rules.Obj_dir.Module.cmt_file obj_dir m ~ml_kind ~cm_kind:(Ocaml Cmi)
+    in
+    { Descr.Mod.name = Module.name m
+    ; impl = source Impl
+    ; intf = source Intf
+    ; cmt = cmt Impl
+    ; cmti = cmt Intf
+    ; module_deps =
+        { for_intf = List.map ~f:Module.name deps_for_intf
+        ; for_impl = List.map ~f:Module.name deps_for_impl
+        }
+    }
+  ;;
+
+  (* Builds the list of modules *)
+  let modules ~obj_dir ~deps_of modules_ : Descr.Mod.t list Memo.t =
+    modules_
+    |> Modules.With_vlib.drop_vlib
+    |> Modules.fold ~init:(Memo.return []) ~f:(fun m macc ->
+      let* acc = macc in
+      let deps = deps_of m in
+      let+ { Ocaml.Ml_kind.Dict.intf = deps_for_intf; impl = deps_for_impl }, _ =
+        Dune_engine.Action_builder.evaluate_and_collect_facts deps
+      in
+      module_ ~obj_dir ~deps_for_intf ~deps_for_impl m :: acc)
+  ;;
+
+  (* Builds a workspace item for the provided executables object *)
+  let executables sctx ~options ~project ~dir (exes : Executables.t)
+    : (Descr.Item.t * Lib.Set.t) option Memo.t
+    =
+    let* expander = Super_context.expander sctx ~dir in
+    Expander.eval_blang expander exes.enabled_if
+    >>= function
+    | false -> Memo.return None
+    | true ->
+      let first_exe = snd (Nonempty_list.hd exes.names) in
+      let* scope =
+        Scope.DB.find_by_project (Super_context.context sctx |> Context.name) project
+      in
+      let* modules_, obj_dir =
+        let+ modules_, obj_dir =
+          Dir_contents.get sctx ~dir
+          >>= Dir_contents.ocaml
+          >>= Ml_sources.modules_and_obj_dir
+                ~libs:(Scope.libs scope)
+                ~for_:(Exe { first_exe })
+        in
+        Modules.With_vlib.modules modules_, obj_dir
+      in
+      let* pp_map =
+        let+ version =
+          let+ ocaml = Super_context.context sctx |> Context.ocaml in
+          ocaml.version
+        in
+        Staged.unstage
+        @@ Pp_spec.pped_modules_map
+             (Dune_lang.Preprocess.Per_module.without_instrumentation
+                exes.buildable.preprocess)
+             version
+      in
+      let deps_of module_ =
+        let module_ = pp_map module_ in
+        immediate_deps_of_module ~options ~obj_dir ~modules:modules_ module_
+      in
+      let obj_dir = Obj_dir.of_local obj_dir in
+      let* modules_ = modules ~obj_dir ~deps_of modules_ in
+      let+ requires =
+        let* compile_info = Exe_rules.compile_info ~scope exes in
+        let open Resolve.Memo.O in
+        let* requires = Lib.Compile.direct_requires compile_info in
+        if options.with_pps
+        then
+          let+ pps = Lib.Compile.pps compile_info in
+          pps @ requires
+        else Resolve.Memo.return requires
+      in
+      (match Resolve.peek requires with
+       | Error () -> None
+       | Ok libs ->
+         let include_dirs = Obj_dir.all_cmis obj_dir in
+         let exe_descr =
+           { Descr.Exe.names = List.map ~f:snd (Nonempty_list.to_list exes.names)
+           ; requires = List.map ~f:uid_of_library libs
+           ; modules = modules_
+           ; include_dirs
+           }
+         in
+         Some (Descr.Item.Executables exe_descr, Lib.Set.of_list libs))
+  ;;
+
+  (* Builds a workspace item for the provided library object *)
+  let library sctx ~options (lib : Lib.t) : Descr.Item.t option Memo.t =
+    let* requires = Lib.requires lib in
+    match Resolve.peek requires with
+    | Error () -> Memo.return None
+    | Ok requires ->
+      let name = Lib.name lib in
+      let info = Lib.info lib in
+      let src_dir = Lib_info.src_dir info in
+      let obj_dir = Lib_info.obj_dir info in
+      let+ modules_ =
+        match Lib.is_local lib with
+        | false -> Memo.return []
+        | true ->
+          (* XXX why do we have a second object directory? *)
+          let* modules_, obj_dir_ =
+            let* libs =
+              Scope.DB.find_by_dir (Path.as_in_build_dir_exn src_dir) >>| Scope.libs
+            in
+            let+ modules_, obj_dir_ =
+              Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir)
+              >>= Dir_contents.ocaml
+              >>= Ml_sources.modules_and_obj_dir
+                    ~libs
+                    ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn))
+            in
+            Modules.With_vlib.modules modules_, obj_dir_
+          in
+          let* pp_map =
+            let+ version =
+              let+ ocaml = Super_context.context sctx |> Context.ocaml in
+              ocaml.version
+            in
+            Staged.unstage
+            @@ Pp_spec.pped_modules_map
+                 (Dune_lang.Preprocess.Per_module.without_instrumentation
+                    (Lib_info.preprocess info))
+                 version
+          in
+          let deps_of module_ =
+            immediate_deps_of_module
+              ~options
+              ~obj_dir:obj_dir_
+              ~modules:modules_
+              (pp_map module_)
+          in
+          modules ~obj_dir ~deps_of modules_
+      in
+      let include_dirs = Obj_dir.all_cmis obj_dir in
+      let lib_descr =
+        { Descr.Lib.name
+        ; uid = uid_of_library lib
+        ; local = Lib.is_local lib
+        ; requires = List.map requires ~f:uid_of_library
+        ; source_dir = src_dir
+        ; modules = modules_
+        ; include_dirs
+        }
+      in
+      Some (Descr.Item.Library lib_descr)
+  ;;
+
+  (* [source_path_is_in_dirs dirs p] tests whether the source path [p] is a
+     descendant of some of the provided directory [dirs]. If [dirs = None],
+     then it always succeeds. If [dirs = Some l], then a matching directory is
+     search in the list [l]. *)
+  let source_path_is_in_dirs dirs (p : Path.Source.t) =
+    match dirs with
+    | None -> true
+    | Some dirs -> List.exists ~f:(fun dir -> Path.Source.is_descendant p ~of_:dir) dirs
+  ;;
+
+  (* Tests whether a dune file is located in a path that is a descendant of
+     some directory *)
+  let dune_file_is_in_dirs dirs dune_file =
+    Dune_file.dir dune_file |> source_path_is_in_dirs dirs
+  ;;
+
+  (* Tests whether a library is located in a path that is a descendant of some
+     directory *)
+  let lib_is_in_dirs dirs (lib : Lib.t) =
+    source_path_is_in_dirs
+      dirs
+      (Path.drop_build_context_exn @@ Lib_info.best_src_dir @@ Lib.info lib)
+  ;;
+
+  (* Builds a workspace item for the root path *)
+  let root () = Descr.Item.Root Path.root
+
+  (* Builds a workspace item for the build directory path *)
+  let build_ctxt (context : Context.t) : Descr.Item.t =
+    Descr.Item.Build_context (Path.build (Context.build_dir context))
+  ;;
+
+  (* Builds a workspace description for the provided dune setup and context *)
+  let workspace
+        options
+        ({ Dune_rules.Main.contexts = _; scontexts } : Dune_rules.Main.build_system)
+        (context : Context.t)
+        dirs
+    : Descr.Workspace.t Memo.t
+    =
+    let context_name = Context.name context in
+    let sctx = Context_name.Map.find_exn scontexts context_name in
+    let open Memo.O in
+    let* dune_files =
+      Dune_load.dune_files context_name >>| List.filter ~f:(dune_file_is_in_dirs dirs)
+    in
+    let* exes, exe_libs =
+      (* the list of workspace items that describe executables, and the list of
+         their direct library dependencies *)
+      Memo.parallel_map dune_files ~f:(fun (dune_file : Dune_file.t) ->
+        Dune_file.stanzas dune_file
+        >>= Memo.parallel_map ~f:(fun stanza ->
+          match Stanza.repr stanza with
+          | Executables.T exes ->
+            let dir =
+              Path.Build.append_source
+                (Context.build_dir context)
+                (Dune_file.dir dune_file)
+            in
+            let project = Dune_file.project dune_file in
+            executables sctx ~options ~project ~dir exes
+          | _ -> Memo.return None)
+        >>| List.filter_opt)
+      >>| List.concat
+      >>| List.split
+    in
+    let exe_libs =
+      (* conflate the dependencies of executables into a single set *)
+      Lib.Set.union_all exe_libs
+    in
+    let* project_libs =
+      (* the list of libraries declared in the project *)
+      Dune_load.projects ()
+      >>= Memo.parallel_map ~f:(fun project ->
+        Scope.DB.find_by_project (Context.name context) project
+        >>| Scope.libs
+        >>= Lib.DB.all)
+      >>| Lib.Set.union_all
+      >>| Lib.Set.filter ~f:(lib_is_in_dirs dirs)
+    in
+    let+ libs =
+      (* the executables' libraries, and the project's libraries *)
+      Lib.Set.union exe_libs project_libs
+      |> Lib.Set.to_list
+      |> Lib.descriptive_closure ~with_pps:options.with_pps
+      >>= Memo.parallel_map ~f:(library ~options sctx)
+      >>| List.filter_opt
+    in
+    let root = root () in
+    let build_ctxt = build_ctxt context in
+    root :: build_ctxt :: (exes @ libs)
+  ;;
+end
+
+let find_dir common dir =
+  let p = Path.Source.(relative root) (Common.prefix_target common dir) in
+  let s = Path.source p in
+  if not @@ Path.exists s
+  then User_error.raise [ Pp.textf "No such file or directory: %s" (Path.to_string s) ];
+  if not @@ Path.is_directory s
+  then
+    User_error.raise
+      [ Pp.textf "File exists, but is not a directory: %s" (Path.to_string s) ];
+  Memo.return p
+;;
+
+let term : unit Term.t =
+  let+ builder = Common.Builder.term
+  and+ what =
+    Arg.(
+      value
+      & pos_all string []
+      & info
+          []
+          ~docv:"DIRS"
+          ~doc:
+            "prints a description of the workspace's structure. If some directories DIRS \
+             are provided, then only those directories of the workspace are considered.")
+  and+ context_name = Common.context_arg ~doc:"Build context to use."
+  and+ format = Describe_format.arg
+  and+ lang = Lang.arg
+  and+ options = Options.arg in
+  let common, config = Common.init builder in
+  let dirs =
+    let args = "workspace" :: what in
+    let parse =
+      Dune_lang.Syntax.set Stanza.syntax (Active lang)
+      @@
+      let open Dune_lang.Decoder in
+      fields
+      @@ field "workspace"
+      @@ let+ dirs = repeat relative_file in
+         (* [None] means that all directories should be accepted,
+            whereas [Some l] means that only the directories in the
+            list [l] should be accepted. The checks on whether the
+            paths exist and whether they are directories are performed
+            later in the [describe] function. *)
+         let dirs = if List.is_empty dirs then None else Some dirs in
+         dirs
+    in
+    let ast =
+      Dune_lang.Ast.add_loc
+        ~loc:Loc.none
+        (List (List.map args ~f:Dune_lang.atom_or_quoted_string))
+    in
+    Dune_lang.Decoder.parse parse Univ_map.empty ast
+  in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  let open Fiber.O in
+  let* setup = Import.Main.setup () in
+  build_exn
+  @@ fun () ->
+  let open Memo.O in
+  let* setup = setup in
+  let super_context = Import.Main.find_scontext_exn setup ~name:context_name in
+  let context = Super_context.context super_context in
+  let* findlib_paths = Context.findlib_paths context in
+  (* prefix directories with the workspace root, so that the
+     command also works correctly when it is run from a
+     subdirectory *)
+  Memo.Option.map dirs ~f:(Memo.List.map ~f:(find_dir common))
+  >>= Crawl.workspace options setup context
+  >>| Sanitize_for_tests.Workspace.sanitize ~findlib_paths
+  >>| Descr.Workspace.to_dyn options
+  >>| Describe_format.print_dyn format
+;;
+
+let command =
+  let doc =
+    "Print a description of the workspace's structure. If some directories DIRS are \
+     provided, then only those directories of the workspace are considered."
+  in
+  let info = Cmd.info ~doc "workspace" in
+  Cmd.v info term
+;;

unikernel/duniverse/dune_/bin/describe/describe_workspace.mli

@@ -0,0 +1,6 @@
+open Import
+
+val term : unit Term.t
+
+(** Dune command that describes the workspace *)
+val command : unit Cmd.t

unikernel/duniverse/dune_/bin/describe/package_entries.ml

@@ -0,0 +1,26 @@
+open Import
+
+let term =
+  let+ builder = Common.Builder.term
+  and+ context_name = Common.context_arg ~doc:"Build context to use."
+  and+ format = Describe_format.arg in
+  let common, config = Common.init builder in
+  Scheduler.go_with_rpc_server ~common ~config
+  @@ fun () ->
+  let open Fiber.O in
+  let* setup = Import.Main.setup () in
+  let* setup = Memo.run setup in
+  let super_context = Import.Main.find_scontext_exn setup ~name:context_name in
+  build_exn
+  @@ fun () ->
+  let open Memo.O in
+  Dune_rules.Install_rules.stanzas_to_entries super_context
+  >>| Package.Name.Map.to_dyn (Dyn.list Install.Entry.Sourced.to_dyn)
+  >>| Describe_format.print_dyn format
+;;
+
+let command =
+  let doc = "prints information about the entries per package." in
+  let info = Cmd.info ~doc "package-entries" in
+  Cmd.v info term
+;;

unikernel/duniverse/dune_/bin/describe/package_entries.mli

@@ -0,0 +1,4 @@
+open Import
+
+(** Dune command to print out information about the entries per package.*)
+val command : unit Cmd.t