From c57cf76da77a05a128d7e28fe0ec01dbff92d2a0 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Fri, 9 Jun 2023 14:29:59 +0200 Subject: [PATCH] refactor(describe): remove describe_common lib Signed-off-by: Ali Caglayan --- bin/describe/describe_common.ml | 174 ------------------- bin/describe/describe_common.mli | 133 -------------- bin/describe/describe_external_lib_deps.ml | 4 +- bin/describe/describe_format.ml | 31 ++++ bin/describe/describe_format.mli | 11 ++ bin/describe/describe_opam_files.ml | 4 +- bin/describe/describe_workspace.ml | 192 ++++++++++++++++++++- 7 files changed, 230 insertions(+), 319 deletions(-) delete mode 100644 bin/describe/describe_common.ml delete mode 100644 bin/describe/describe_common.mli create mode 100644 bin/describe/describe_format.ml create mode 100644 bin/describe/describe_format.mli diff --git a/bin/describe/describe_common.ml b/bin/describe/describe_common.ml deleted file mode 100644 index a9f010dcbd7e..000000000000 --- a/bin/describe/describe_common.ml +++ /dev/null @@ -1,174 +0,0 @@ -open Stdune -open Import - -module Descr = struct - type options = - { with_deps : bool - ; with_pps : bool - } - - let dyn_path (p : Path.t) : Dyn.t = String (Path.to_string p) - - module Mod_deps = struct - type t = - { for_intf : Dune_rules.Module_name.t list - ; for_impl : Dune_rules.Module_name.t list - } - - 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 - - module Mod = struct - type t = - { name : Dune_rules.Module_name.t - ; impl : Path.t option - ; intf : Path.t option - ; cmt : Path.t option - ; cmti : Path.t option - ; module_deps : Mod_deps.t - } - - let to_dyn options { name; impl; intf; cmt; cmti; module_deps } : Dyn.t = - let open Dyn in - let optional_fields = - let module_deps = - if options.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 - - module Exe = struct - type t = - { names : string list - ; requires : Dune_digest.t list - ; modules : Mod.t list - ; include_dirs : Path.t list - } - - let map_path t ~f = { t with include_dirs = List.map ~f t.include_dirs } - - 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 - - module Lib = struct - type t = - { name : Lib_name.t - ; uid : Dune_digest.t - ; local : bool - ; requires : Dune_digest.t list - ; source_dir : Path.t - ; modules : Mod.t list - ; include_dirs : Path.t list - } - - let map_path t ~f = - { t with - source_dir = f t.source_dir - ; include_dirs = List.map ~f t.include_dirs - } - - 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 - - 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) - - 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 - - module Workspace = struct - type t = Item.t list - - let to_dyn options (items : t) : Dyn.t = - Dyn.list (Item.to_dyn options) items - end -end - -module Format = struct - 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 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 -end diff --git a/bin/describe/describe_common.mli b/bin/describe/describe_common.mli deleted file mode 100644 index 69f10cc9525b..000000000000 --- a/bin/describe/describe_common.mli +++ /dev/null @@ -1,133 +0,0 @@ -open Import -open Stdune - -(** Common library for "dune describe" style commands. This module contains two - modules: - - - [Desc] which is a description of a workspace that can be serialised. - - [Format] which provides outputs serialisation support for a command. *) - -(** 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 : sig - (** Option flags for what to do while crawling the workspace *) - type options = - { 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) *) - } - - (** [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. *) - val dyn_path : Path.t -> Dyn.t - - (** Description of the dependencies of a module *) - module Mod_deps : sig - 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 *) - val to_dyn : t -> Dyn.t - end - - (** Description of modules *) - module Mod : sig - 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 *) - val to_dyn : options -> t -> Dyn.t - end - - (** Description of executables *) - module Exe : sig - 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 *) - } - - val map_path : t -> f:(Path.t -> Path.t) -> t - - (** Conversion to the [Dyn.t] type *) - val to_dyn : options -> t -> Dyn.t - end - - (** Description of libraries *) - module Lib : sig - 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 *) - } - - val map_path : t -> f:(Path.t -> Path.t) -> t - - (** Conversion to the [Dyn.t] type *) - val to_dyn : options -> t -> Dyn.t - end - - (** Description of items: executables, or libraries *) - module Item : sig - type t = - | Executables of Exe.t - | Library of Lib.t - | Root of Path.t - | Build_context of Path.t - - val map_path : t -> f:(Path.t -> Path.t) -> t - - (** Conversion to the [Dyn.t] type *) - val to_dyn : options -> t -> Dyn.t - end - - (** Description of a workspace: a list of items *) - module Workspace : sig - type t = Item.t list - - (** Conversion to the [Dyn.t] type *) - val to_dyn : options -> t -> Dyn.t - end -end - -module Format : sig - type t = - | Sexp - | Csexp - - val arg : t Term.t - - val print_dyn : t -> Dyn.t -> unit -end diff --git a/bin/describe/describe_external_lib_deps.ml b/bin/describe/describe_external_lib_deps.ml index 3921d7778750..4d7f24170898 100644 --- a/bin/describe/describe_external_lib_deps.ml +++ b/bin/describe/describe_external_lib_deps.ml @@ -160,7 +160,7 @@ let to_dyn context_name external_resolved_libs = let term = let+ common = Common.term and+ context_name = Common.context_arg ~doc:"Build context to use." - and+ format = Describe_common.Format.arg in + and+ format = Describe_format.arg in let config = Common.init common in Scheduler.go ~common ~config @@ fun () -> let open Fiber.O in @@ -175,7 +175,7 @@ let term = in external_resolved_libs setup super_context >>| to_dyn context_name - >>| Describe_common.Format.print_dyn format + >>| Describe_format.print_dyn format let command = let doc = diff --git a/bin/describe/describe_format.ml b/bin/describe/describe_format.ml new file mode 100644 index 000000000000..3171bf97b387 --- /dev/null +++ b/bin/describe/describe_format.ml @@ -0,0 +1,31 @@ +open Stdune +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 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 diff --git a/bin/describe/describe_format.mli b/bin/describe/describe_format.mli new file mode 100644 index 000000000000..310dff2a1c8a --- /dev/null +++ b/bin/describe/describe_format.mli @@ -0,0 +1,11 @@ +open Import + +(** Formatting utilities for dune describe commands *) + +type t = + | Sexp + | Csexp + +val arg : t Term.t + +val print_dyn : t -> Dyn.t -> unit diff --git a/bin/describe/describe_opam_files.ml b/bin/describe/describe_opam_files.ml index 413bc4d1ad7d..9c35de5b12e0 100644 --- a/bin/describe/describe_opam_files.ml +++ b/bin/describe/describe_opam_files.ml @@ -3,7 +3,7 @@ open Stdune let term = let+ common = Common.term - and+ format = Describe_common.Format.arg in + and+ format = Describe_format.arg in let config = Common.init common in Scheduler.go ~common ~config @@ fun () -> Build_system.run_exn @@ fun () -> @@ -26,7 +26,7 @@ let term = Dyn.Tuple [ String (Path.to_string opam_file); String contents ] in Dyn.List (List.map packages ~f:opam_file_to_dyn) - |> Describe_common.Format.print_dyn format + |> Describe_format.print_dyn format let command = let doc = diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index c633553d4bcd..50b9256a0bc6 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -2,7 +2,14 @@ open Import open Stdune module Options = struct - type t = Describe_common.Descr.options + (** 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 *) @@ -35,7 +42,177 @@ module Options = struct and+ with_pps = arg_with_pps and+ sanitize_for_tests_value = arg_sanitize_for_tests in sanitize_for_tests := sanitize_for_tests_value; - { Describe_common.Descr.with_deps; with_pps } + { 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 @@ -123,7 +300,7 @@ module Sanitize_for_tests = struct 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:(Describe_common.Descr.Item.map_path ~f:rename_path) items + 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 *) @@ -135,7 +312,6 @@ end (** Crawl the workspace to get all the data *) module Crawl = struct - open Describe_common open Dune_rules open Dune_engine open Memo.O @@ -149,7 +325,7 @@ module Crawl = struct else Digest.generic name let immediate_deps_of_module ~options ~obj_dir ~modules unit = - match (options : Describe_common.Descr.options) with + match (options : Options.t) with | { with_deps = false; _ } -> Action_builder.return { Ocaml.Ml_kind.Dict.intf = []; impl = [] } | { with_deps = true; _ } -> @@ -374,7 +550,7 @@ let term : unit Term.t = 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_common.Format.arg + and+ format = Describe_format.arg and+ lang = Lang.arg and+ options = Options.arg in let config = Common.init common in @@ -429,8 +605,8 @@ let term : unit Term.t = Memo.return p)) >>= Crawl.workspace options setup context >>| Sanitize_for_tests.Workspace.sanitize context - >>| Describe_common.Descr.Workspace.to_dyn options - >>| Describe_common.Format.print_dyn format + >>| Descr.Workspace.to_dyn options + >>| Describe_format.print_dyn format let command = let doc =