Merge pull request #1158 from rgrinberg/abstract-dune-project
Make Dune_project.t abstract
This commit is contained in:
commit
b424ba970b
|
@ -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 ||
|
||||
|
|
|
@ -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 <package>.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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
13
src/scope.ml
13
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;
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue