From 0a1b305df1b40375addb97bd69cae545e4a42a65 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 17 Jan 2024 20:20:41 -0700 Subject: [PATCH] refactor: Make [Dune_load.t] abstract Signed-off-by: Rudi Grinberg --- bin/describe/describe_external_lib_deps.ml | 3 ++- bin/describe/describe_workspace.ml | 9 +++++---- bin/install_uninstall.ml | 4 ++-- src/dune_rules/dune_load.ml | 5 +++++ src/dune_rules/dune_load.mli | 12 ++++++------ src/dune_rules/env_stanza_db.ml | 2 +- src/dune_rules/lib.ml | 7 ++++--- src/dune_rules/odoc.ml | 2 +- src/dune_rules/odoc_new.ml | 2 +- src/dune_rules/only_packages.ml | 10 +++------- src/dune_rules/scope.ml | 2 +- 11 files changed, 31 insertions(+), 27 deletions(-) diff --git a/bin/describe/describe_external_lib_deps.ml b/bin/describe/describe_external_lib_deps.ml index 5a464e70ab7..98a4702bbed 100644 --- a/bin/describe/describe_external_lib_deps.ml +++ b/bin/describe/describe_external_lib_deps.ml @@ -143,7 +143,8 @@ let libs db (context : Context.t) (build_system : Dune_rules.Main.build_system) let { Dune_rules.Main.conf; contexts = _; _ } = build_system in let open Memo.O in let* dune_files = - Dune_rules.Dune_load.Dune_files.eval conf.dune_files ~context:(Context.name context) + Dune_rules.Dune_load.dune_files conf + |> Dune_rules.Dune_load.Dune_files.eval ~context:(Context.name context) in Memo.parallel_map dune_files ~f:(fun (dune_file : Dune_rules.Dune_file.t) -> Memo.parallel_map dune_file.stanzas ~f:(fun stanza -> diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index 730fdd13317..ae2dc92e240 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -527,7 +527,8 @@ module Crawl = struct let sctx = Context_name.Map.find_exn scontexts context_name in let open Memo.O in let* dune_files = - Dune_load.Dune_files.eval conf.dune_files ~context:context_name + Dune_load.dune_files conf + |> Dune_load.Dune_files.eval ~context:context_name >>| List.filter ~f:(dune_file_is_in_dirs dirs) in let* exes, exe_libs = @@ -550,9 +551,9 @@ module Crawl = struct in let* project_libs = (* the list of libraries declared in the project *) - Memo.parallel_map conf.projects ~f:(fun project -> - let* scope = Scope.DB.find_by_project context project in - Scope.libs scope |> Lib.DB.all) + Dune_load.projects conf + |> Memo.parallel_map ~f:(fun project -> + Scope.DB.find_by_project context project >>| Scope.libs >>= Lib.DB.all) >>| Lib.Set.union_all >>| Lib.Set.filter ~f:(lib_is_in_dirs dirs) in diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml index 6467724458c..da827652d30 100644 --- a/bin/install_uninstall.ml +++ b/bin/install_uninstall.ml @@ -81,9 +81,9 @@ module Workspace = struct let get () = let open Memo.O in Memo.run - (let+ conf = Dune_rules.Dune_load.load () + (let+ packages = Dune_rules.Dune_load.load () >>| Dune_rules.Dune_load.packages and+ contexts = Context.DB.all () in - { packages = conf.packages; contexts }) + { packages; contexts }) ;; let package_install_file t ~findlib_toolchain pkg = diff --git a/src/dune_rules/dune_load.ml b/src/dune_rules/dune_load.ml index de0b1000060..603ce5e0f58 100644 --- a/src/dune_rules/dune_load.ml +++ b/src/dune_rules/dune_load.ml @@ -300,6 +300,11 @@ type t = ; projects_by_root : Dune_project.t Path.Source.Map.t } +let dune_files t = t.dune_files +let packages t = t.packages +let projects t = t.projects +let projects_by_root t = t.projects_by_root + module Projects_and_dune_files = Monoid.Product (Monoid.Appendable_list (struct diff --git a/src/dune_rules/dune_load.mli b/src/dune_rules/dune_load.mli index dda84923faf..7b3e7cb379c 100644 --- a/src/dune_rules/dune_load.mli +++ b/src/dune_rules/dune_load.mli @@ -13,12 +13,12 @@ module Dune_files : sig val in_dir : Path.Build.t -> Dune_file.t option Memo.t end -type t = private - { dune_files : Dune_files.t - ; packages : Package.t Package.Name.Map.t - ; projects : Dune_project.t list - ; projects_by_root : Dune_project.t Path.Source.Map.t - } +type t + +val dune_files : t -> Dune_files.t +val packages : t -> Package.t Package.Name.Map.t +val projects : t -> Dune_project.t list +val projects_by_root : t -> Dune_project.t Path.Source.Map.t (** Load all dune files. This function is memoized. *) val load : unit -> t Memo.t diff --git a/src/dune_rules/env_stanza_db.ml b/src/dune_rules/env_stanza_db.ml index 2c61facb08f..0ca2e87a1c6 100644 --- a/src/dune_rules/env_stanza_db.ml +++ b/src/dune_rules/env_stanza_db.ml @@ -130,7 +130,7 @@ module Inherit = struct (sprintf "%s-root" name) ~input:(module Path.Source) (fun dir -> - let* { Dune_load.projects_by_root; _ } = Dune_load.load () + let* projects_by_root = Dune_load.load () >>| Dune_load.projects_by_root and* envs = Memo.Lazy.force for_context in let project = Path.Source.Map.find_exn projects_by_root dir in let root = root context project in diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 029c0a73097..993463a5cab 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -858,13 +858,14 @@ end = struct let projects_by_package = Memo.lazy_ (fun () -> let open Memo.O in - let+ { projects; _ } = Dune_load.load () in - List.concat_map projects ~f:(fun project -> + Dune_load.load () + >>| Dune_load.projects + >>| List.concat_map ~f:(fun project -> Dune_project.packages project |> Package.Name.Map.to_list_map ~f:(fun _ (pkg : Package.t) -> let name = Package.name pkg in name, project)) - |> Package.Name.Map.of_list_exn) + >>| Package.Name.Map.of_list_exn) ;; let instantiate_impl (db, name, info, hidden) = diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 1c5c58a5f4e..2aeabe2bfd3 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -23,7 +23,7 @@ let find_project_by_key = Memo.create "project-by-keys" ~input:(module Input) make_map in fun key -> - let* { projects; _ } = Dune_load.load () in + let* projects = Dune_load.load () >>| Dune_load.projects in let+ map = Memo.exec memo projects in Dune_project.File_key.Map.find_exn map key ;; diff --git a/src/dune_rules/odoc_new.ml b/src/dune_rules/odoc_new.ml index 7e772fb2d3c..e265839fa99 100644 --- a/src/dune_rules/odoc_new.ml +++ b/src/dune_rules/odoc_new.ml @@ -485,7 +485,7 @@ module Valid = struct ;; let get ctx ~all = - let* { projects; _ } = Dune_load.load () in + let* projects = Dune_load.load () >>| Dune_load.projects in Memo.exec valid_libs_and_packages (ctx, all, projects) ;; diff --git a/src/dune_rules/only_packages.ml b/src/dune_rules/only_packages.ml index 96b1666c81b..7c774c69891 100644 --- a/src/dune_rules/only_packages.ml +++ b/src/dune_rules/only_packages.ml @@ -31,7 +31,7 @@ let conf = match Clflags.t () with | No_restriction -> Memo.return None | Restrict { names; command_line_option } -> - let* { packages; _ } = Dune_load.load () in + let* packages = Dune_load.load () >>| Dune_load.packages in Package.Name.Set.iter names ~f:(fun pkg_name -> if not (Package.Name.Map.mem packages pkg_name) then ( @@ -105,9 +105,7 @@ let filtered_stanzas = Per_context.create_by_name ~name:"filtered_stanzas" @@ fun context -> let* only_packages = Memo.Lazy.force conf - and+ { Dune_load.dune_files; packages = _; projects = _; projects_by_root = _ } = - Dune_load.load () - in + and+ dune_files = Dune_load.load () >>| Dune_load.dune_files in let+ stanzas = Dune_load.Dune_files.eval ~context dune_files in match only_packages with | None -> stanzas @@ -121,9 +119,7 @@ let filtered_stanzas = ;; let get () = - let* { Dune_load.dune_files = _; packages; projects = _; projects_by_root = _ } = - Dune_load.load () - in + let* packages = Dune_load.load () >>| Dune_load.packages in let+ only_packages = Memo.Lazy.force conf in Option.value only_packages ~default:packages ;; diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 90d05087d05..34dabe1c214 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -336,7 +336,7 @@ module DB = struct let scopes = Memo.Lazy.create @@ fun () -> - let* { Dune_load.projects_by_root; _ } = Dune_load.load () in + let* projects_by_root = Dune_load.load () >>| Dune_load.projects_by_root in let* stanzas = Only_packages.filtered_stanzas (Context.name context) in create_from_stanzas ~projects_by_root ~context stanzas in