From 83d43ecc42416723d1b1cb4edc2199981a847f39 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 21 Aug 2018 13:12:28 +0300 Subject: [PATCH] Make Dune_project.t abstract Signed-off-by: Rudi Grinberg --- src/dir_contents.ml | 5 ++++- src/dune_file.ml | 15 ++++++++------- src/dune_project.ml | 18 ++++++++++++------ src/dune_project.mli | 17 +++++++---------- src/install_rules.ml | 2 +- src/jbuild_load.ml | 4 ++-- src/lib.ml | 2 +- src/scope.ml | 13 +++++++------ src/super_context.ml | 5 +++-- 9 files changed, 45 insertions(+), 36 deletions(-) diff --git a/src/dir_contents.ml b/src/dir_contents.ml index 0da00173..4b8d3b78 100644 --- a/src/dir_contents.ml +++ b/src/dir_contents.ml @@ -548,7 +548,10 @@ module Dir_status = struct Is_component_of_a_group_but_not_the_root None end | Some ft_dir -> - let project_root = Path.of_local (File_tree.Dir.project ft_dir).root in + let project_root = + File_tree.Dir.project ft_dir + |> Dune_project.root + |> Path.of_local in match Super_context.stanzas_in sctx ~dir with | None -> if Path.equal dir project_root || diff --git a/src/dune_file.ml b/src/dune_file.ml index f202cf45..38d6cda2 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -167,7 +167,7 @@ module Pkg = struct (Path.to_string (Package.opam_file pkg)))) let default (project : Dune_project.t) stanza = - match Package.Name.Map.values project.packages with + match Package.Name.Map.values (Dune_project.packages project) with | [pkg] -> Ok pkg | [] -> Error @@ -182,16 +182,17 @@ module Pkg = struct stanza is for.\nI have the choice between these ones:\n\ %s\n\ You need to add a (package ...) field to this (%s) stanza." - (listing (Package.Name.Map.values project.packages)) + (listing (Package.Name.Map.values (Dune_project.packages project))) stanza) let resolve (project : Dune_project.t) name = - match Package.Name.Map.find project.packages name with + let packages = Dune_project.packages project in + match Package.Name.Map.find packages name with | Some pkg -> Ok pkg | None -> let name_s = Package.Name.to_string name in - if Package.Name.Map.is_empty project.packages then + if Package.Name.Map.is_empty packages then Error (sprintf "You cannot declare items to be installed without \ adding a .opam file at the root of your project.\n\ @@ -205,8 +206,8 @@ module Pkg = struct elements to be installed in this directory are:\n\ %s%s" name_s - (listing (Package.Name.Map.values project.packages)) - (hint name_s (Package.Name.Map.keys project.packages + (listing (Package.Name.Map.values packages)) + (hint name_s (Package.Name.Map.keys packages |> List.map ~f:Package.Name.to_string))) let t = @@ -1856,7 +1857,7 @@ module Stanzas = struct let (parser, lexer) = match (kind : File_tree.Dune_file.Kind.t) with | Jbuild -> (jbuild_parser, Usexp.Lexer.jbuild_token) - | Dune -> (project.stanza_parser, Usexp.Lexer.token) + | Dune -> (Dune_project.stanza_parser project, Usexp.Lexer.token) in (Dune_project.set project parser, lexer) in diff --git a/src/dune_project.ml b/src/dune_project.ml index c40f4f6c..a5ac25d8 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -149,6 +149,12 @@ type t = ; project_file : Project_file.t } +let packages t = t.packages +let version t = t.version +let name t = t.name +let root t = t.root +let stanza_parser t = t.stanza_parser + include Versioned_file.Make(struct type t = Stanza.Parser.t list end) @@ -328,15 +334,15 @@ let default_name ~dir ~packages = "%S is not a valid opam package name." name -let name ~dir ~packages = - let%map name = field_o "name" Name.named_of_sexp in - match name with - | Some x -> x - | None -> default_name ~dir ~packages +let name_field ~dir ~packages = + let%map name = field_o "name" Name.named_of_sexp in + match name with + | Some x -> x + | None -> default_name ~dir ~packages let parse ~dir ~lang ~packages ~file = fields - (let%map name = name ~dir ~packages + (let%map name = name_field ~dir ~packages and version = field_o "version" string and extensions = multi_field "using" diff --git a/src/dune_project.mli b/src/dune_project.mli index 482d54b6..2b073f2f 100644 --- a/src/dune_project.mli +++ b/src/dune_project.mli @@ -35,16 +35,13 @@ module Project_file : sig type t end -(* CR-soon diml: make this abstract *) -type t = private - { kind : Kind.t - ; name : Name.t - ; root : Path.Local.t - ; version : string option - ; packages : Package.t Package.Name.Map.t - ; stanza_parser : Stanza.t list Sexp.Of_sexp.t - ; project_file : Project_file.t - } +type t + +val packages : t -> Package.t Package.Name.Map.t +val version : t -> string option +val name : t -> Name.t +val root : t -> Path.Local.t +val stanza_parser : t -> Stanza.t list Sexp.Of_sexp.t module Lang : sig (** [register id stanzas_parser] register a new language. Users will diff --git a/src/install_rules.ml b/src/install_rules.ml index 62e20c4e..2d64eff2 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -31,7 +31,7 @@ module Gen(P : Params) = struct let version_from_dune_project (pkg : Package.t) = let dir = Path.append (SC.build_dir sctx) pkg.path in let project = Scope.project (SC.find_scope_by_dir sctx dir) in - project.version + Dune_project.version project type version_method = | File of string diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 6bbb66fe..dee5569a 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -242,13 +242,13 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = ~f:(fun dir acc -> let p = File_tree.Dir.project dir in match Path.kind (File_tree.Dir.path dir) with - | Local d when Path.Local.equal d p.root -> p :: acc + | Local d when Path.Local.equal d (Dune_project.root p) -> p :: acc | _ -> acc) in let packages = List.fold_left projects ~init:Package.Name.Map.empty ~f:(fun acc (p : Dune_project.t) -> - Package.Name.Map.merge acc p.packages ~f:(fun name a b -> + Package.Name.Map.merge acc (Dune_project.packages p) ~f:(fun name a b -> match a, b with | None, None -> None | None, Some _ -> b diff --git a/src/lib.ml b/src/lib.ml index e9f8d794..d9cde3bc 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -83,7 +83,7 @@ module Info = struct in let status = match conf.public with - | None -> Status.Private conf.project.name + | None -> Status.Private (Dune_project.name conf.project) | Some p -> Public p.package in let foreign_archives = diff --git a/src/scope.ml b/src/scope.ml index 685bf425..2eec9380 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -7,7 +7,7 @@ type t = } let root t = t.root -let name t = t.project.name +let name t = Dune_project.name t.project let project t = t.project let libs t = t.db @@ -53,14 +53,14 @@ module DB = struct let create ~projects ~context ~installed_libs ~ext_lib internal_libs = let projects_by_name = List.map projects ~f:(fun (project : Dune_project.t) -> - (project.name, project)) + (Dune_project.name project, project)) |> Project_name_map.of_list |> function | Ok x -> x | Error (_name, project1, project2) -> let to_sexp (project : Dune_project.t) = Sexp.To_sexp.(pair Dune_project.Name.sexp_of_t Path.Local.sexp_of_t) - (project.name, project.root) + (Dune_project.name project, Dune_project.root project) in Exn.code_error "Scope.DB.create got two projects with the same name" [ "project1", to_sexp project1 @@ -69,7 +69,7 @@ module DB = struct in let libs_by_project_name = List.map internal_libs ~f:(fun (dir, (lib : Dune_file.Library.t)) -> - (lib.project.name, (dir, lib))) + (Dune_project.name lib.project, (dir, lib))) |> Project_name_map.of_list_multi in let by_name_cell = ref Project_name_map.empty in @@ -107,7 +107,7 @@ module DB = struct | Some project -> let scope = Option.value_exn - (Project_name_map.find !by_name_cell project.name) + (Project_name_map.find !by_name_cell (Dune_project.name project)) in Redirect (Some scope.db, name)) ~all:(fun () -> String.Map.keys public_libs) @@ -121,7 +121,8 @@ module DB = struct let db = Lib.DB.create_from_library_stanzas libs ~parent:public_libs ~ext_lib in - let root = Path.append_local build_context_dir project.root in + let root = + Path.append_local build_context_dir (Dune_project.root project) in Some { project; db; root }) in by_name_cell := by_name; diff --git a/src/super_context.ml b/src/super_context.ml index ebbaafdb..72e84a7b 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -335,7 +335,8 @@ end = struct Lib.DB.available (Scope.libs scope) lib))) end | Macro (Version, s) -> begin - match Package.Name.Map.find (Scope.project scope).packages + match Package.Name.Map.find + (Dune_project.packages (Scope.project scope)) (Package.Name.of_string s) with | Some p -> let x = @@ -523,7 +524,7 @@ let create src_dir = dir ; ctx_dir ; stanzas - ; scope = Scope.DB.find_by_name scopes project.Dune_project.name + ; scope = Scope.DB.find_by_name scopes (Dune_project.name project) ; kind }) in