Make Dune_project.t abstract
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
5b6496fac1
commit
83d43ecc42
|
@ -548,7 +548,10 @@ module Dir_status = struct
|
||||||
Is_component_of_a_group_but_not_the_root None
|
Is_component_of_a_group_but_not_the_root None
|
||||||
end
|
end
|
||||||
| Some ft_dir ->
|
| 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
|
match Super_context.stanzas_in sctx ~dir with
|
||||||
| None ->
|
| None ->
|
||||||
if Path.equal dir project_root ||
|
if Path.equal dir project_root ||
|
||||||
|
|
|
@ -167,7 +167,7 @@ module Pkg = struct
|
||||||
(Path.to_string (Package.opam_file pkg))))
|
(Path.to_string (Package.opam_file pkg))))
|
||||||
|
|
||||||
let default (project : Dune_project.t) stanza =
|
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
|
| [pkg] -> Ok pkg
|
||||||
| [] ->
|
| [] ->
|
||||||
Error
|
Error
|
||||||
|
@ -182,16 +182,17 @@ module Pkg = struct
|
||||||
stanza is for.\nI have the choice between these ones:\n\
|
stanza is for.\nI have the choice between these ones:\n\
|
||||||
%s\n\
|
%s\n\
|
||||||
You need to add a (package ...) field to this (%s) stanza."
|
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)
|
stanza)
|
||||||
|
|
||||||
let resolve (project : Dune_project.t) name =
|
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 ->
|
| Some pkg ->
|
||||||
Ok pkg
|
Ok pkg
|
||||||
| None ->
|
| None ->
|
||||||
let name_s = Package.Name.to_string name in
|
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
|
Error (sprintf
|
||||||
"You cannot declare items to be installed without \
|
"You cannot declare items to be installed without \
|
||||||
adding a <package>.opam file at the root of your project.\n\
|
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\
|
elements to be installed in this directory are:\n\
|
||||||
%s%s"
|
%s%s"
|
||||||
name_s
|
name_s
|
||||||
(listing (Package.Name.Map.values project.packages))
|
(listing (Package.Name.Map.values packages))
|
||||||
(hint name_s (Package.Name.Map.keys project.packages
|
(hint name_s (Package.Name.Map.keys packages
|
||||||
|> List.map ~f:Package.Name.to_string)))
|
|> List.map ~f:Package.Name.to_string)))
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
|
@ -1856,7 +1857,7 @@ module Stanzas = struct
|
||||||
let (parser, lexer) =
|
let (parser, lexer) =
|
||||||
match (kind : File_tree.Dune_file.Kind.t) with
|
match (kind : File_tree.Dune_file.Kind.t) with
|
||||||
| Jbuild -> (jbuild_parser, Usexp.Lexer.jbuild_token)
|
| Jbuild -> (jbuild_parser, Usexp.Lexer.jbuild_token)
|
||||||
| Dune -> (project.stanza_parser, Usexp.Lexer.token)
|
| Dune -> (Dune_project.stanza_parser project, Usexp.Lexer.token)
|
||||||
in
|
in
|
||||||
(Dune_project.set project parser, lexer)
|
(Dune_project.set project parser, lexer)
|
||||||
in
|
in
|
||||||
|
|
|
@ -149,6 +149,12 @@ type t =
|
||||||
; project_file : Project_file.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
|
include Versioned_file.Make(struct
|
||||||
type t = Stanza.Parser.t list
|
type t = Stanza.Parser.t list
|
||||||
end)
|
end)
|
||||||
|
@ -328,7 +334,7 @@ let default_name ~dir ~packages =
|
||||||
"%S is not a valid opam package name."
|
"%S is not a valid opam package name."
|
||||||
name
|
name
|
||||||
|
|
||||||
let name ~dir ~packages =
|
let name_field ~dir ~packages =
|
||||||
let%map name = field_o "name" Name.named_of_sexp in
|
let%map name = field_o "name" Name.named_of_sexp in
|
||||||
match name with
|
match name with
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
|
@ -336,7 +342,7 @@ let name ~dir ~packages =
|
||||||
|
|
||||||
let parse ~dir ~lang ~packages ~file =
|
let parse ~dir ~lang ~packages ~file =
|
||||||
fields
|
fields
|
||||||
(let%map name = name ~dir ~packages
|
(let%map name = name_field ~dir ~packages
|
||||||
and version = field_o "version" string
|
and version = field_o "version" string
|
||||||
and extensions =
|
and extensions =
|
||||||
multi_field "using"
|
multi_field "using"
|
||||||
|
|
|
@ -35,16 +35,13 @@ module Project_file : sig
|
||||||
type t
|
type t
|
||||||
end
|
end
|
||||||
|
|
||||||
(* CR-soon diml: make this abstract *)
|
type t
|
||||||
type t = private
|
|
||||||
{ kind : Kind.t
|
val packages : t -> Package.t Package.Name.Map.t
|
||||||
; name : Name.t
|
val version : t -> string option
|
||||||
; root : Path.Local.t
|
val name : t -> Name.t
|
||||||
; version : string option
|
val root : t -> Path.Local.t
|
||||||
; packages : Package.t Package.Name.Map.t
|
val stanza_parser : t -> Stanza.t list Sexp.Of_sexp.t
|
||||||
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
|
|
||||||
; project_file : Project_file.t
|
|
||||||
}
|
|
||||||
|
|
||||||
module Lang : sig
|
module Lang : sig
|
||||||
(** [register id stanzas_parser] register a new language. Users will
|
(** [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 version_from_dune_project (pkg : Package.t) =
|
||||||
let dir = Path.append (SC.build_dir sctx) pkg.path in
|
let dir = Path.append (SC.build_dir sctx) pkg.path in
|
||||||
let project = Scope.project (SC.find_scope_by_dir sctx dir) in
|
let project = Scope.project (SC.find_scope_by_dir sctx dir) in
|
||||||
project.version
|
Dune_project.version project
|
||||||
|
|
||||||
type version_method =
|
type version_method =
|
||||||
| File of string
|
| File of string
|
||||||
|
|
|
@ -242,13 +242,13 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
||||||
~f:(fun dir acc ->
|
~f:(fun dir acc ->
|
||||||
let p = File_tree.Dir.project dir in
|
let p = File_tree.Dir.project dir in
|
||||||
match Path.kind (File_tree.Dir.path dir) with
|
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)
|
| _ -> acc)
|
||||||
in
|
in
|
||||||
let packages =
|
let packages =
|
||||||
List.fold_left projects ~init:Package.Name.Map.empty
|
List.fold_left projects ~init:Package.Name.Map.empty
|
||||||
~f:(fun acc (p : Dune_project.t) ->
|
~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
|
match a, b with
|
||||||
| None, None -> None
|
| None, None -> None
|
||||||
| None, Some _ -> b
|
| None, Some _ -> b
|
||||||
|
|
|
@ -83,7 +83,7 @@ module Info = struct
|
||||||
in
|
in
|
||||||
let status =
|
let status =
|
||||||
match conf.public with
|
match conf.public with
|
||||||
| None -> Status.Private conf.project.name
|
| None -> Status.Private (Dune_project.name conf.project)
|
||||||
| Some p -> Public p.package
|
| Some p -> Public p.package
|
||||||
in
|
in
|
||||||
let foreign_archives =
|
let foreign_archives =
|
||||||
|
|
13
src/scope.ml
13
src/scope.ml
|
@ -7,7 +7,7 @@ type t =
|
||||||
}
|
}
|
||||||
|
|
||||||
let root t = t.root
|
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 project t = t.project
|
||||||
let libs t = t.db
|
let libs t = t.db
|
||||||
|
|
||||||
|
@ -53,14 +53,14 @@ module DB = struct
|
||||||
let create ~projects ~context ~installed_libs ~ext_lib internal_libs =
|
let create ~projects ~context ~installed_libs ~ext_lib internal_libs =
|
||||||
let projects_by_name =
|
let projects_by_name =
|
||||||
List.map projects ~f:(fun (project : Dune_project.t) ->
|
List.map projects ~f:(fun (project : Dune_project.t) ->
|
||||||
(project.name, project))
|
(Dune_project.name project, project))
|
||||||
|> Project_name_map.of_list
|
|> Project_name_map.of_list
|
||||||
|> function
|
|> function
|
||||||
| Ok x -> x
|
| Ok x -> x
|
||||||
| Error (_name, project1, project2) ->
|
| Error (_name, project1, project2) ->
|
||||||
let to_sexp (project : Dune_project.t) =
|
let to_sexp (project : Dune_project.t) =
|
||||||
Sexp.To_sexp.(pair Dune_project.Name.sexp_of_t Path.Local.sexp_of_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
|
in
|
||||||
Exn.code_error "Scope.DB.create got two projects with the same name"
|
Exn.code_error "Scope.DB.create got two projects with the same name"
|
||||||
[ "project1", to_sexp project1
|
[ "project1", to_sexp project1
|
||||||
|
@ -69,7 +69,7 @@ module DB = struct
|
||||||
in
|
in
|
||||||
let libs_by_project_name =
|
let libs_by_project_name =
|
||||||
List.map internal_libs ~f:(fun (dir, (lib : Dune_file.Library.t)) ->
|
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
|
|> Project_name_map.of_list_multi
|
||||||
in
|
in
|
||||||
let by_name_cell = ref Project_name_map.empty in
|
let by_name_cell = ref Project_name_map.empty in
|
||||||
|
@ -107,7 +107,7 @@ module DB = struct
|
||||||
| Some project ->
|
| Some project ->
|
||||||
let scope =
|
let scope =
|
||||||
Option.value_exn
|
Option.value_exn
|
||||||
(Project_name_map.find !by_name_cell project.name)
|
(Project_name_map.find !by_name_cell (Dune_project.name project))
|
||||||
in
|
in
|
||||||
Redirect (Some scope.db, name))
|
Redirect (Some scope.db, name))
|
||||||
~all:(fun () -> String.Map.keys public_libs)
|
~all:(fun () -> String.Map.keys public_libs)
|
||||||
|
@ -121,7 +121,8 @@ module DB = struct
|
||||||
let db =
|
let db =
|
||||||
Lib.DB.create_from_library_stanzas libs ~parent:public_libs ~ext_lib
|
Lib.DB.create_from_library_stanzas libs ~parent:public_libs ~ext_lib
|
||||||
in
|
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 })
|
Some { project; db; root })
|
||||||
in
|
in
|
||||||
by_name_cell := by_name;
|
by_name_cell := by_name;
|
||||||
|
|
|
@ -335,7 +335,8 @@ end = struct
|
||||||
Lib.DB.available (Scope.libs scope) lib)))
|
Lib.DB.available (Scope.libs scope) lib)))
|
||||||
end
|
end
|
||||||
| Macro (Version, s) -> begin
|
| 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
|
(Package.Name.of_string s) with
|
||||||
| Some p ->
|
| Some p ->
|
||||||
let x =
|
let x =
|
||||||
|
@ -523,7 +524,7 @@ let create
|
||||||
src_dir = dir
|
src_dir = dir
|
||||||
; ctx_dir
|
; ctx_dir
|
||||||
; stanzas
|
; stanzas
|
||||||
; scope = Scope.DB.find_by_name scopes project.Dune_project.name
|
; scope = Scope.DB.find_by_name scopes (Dune_project.name project)
|
||||||
; kind
|
; kind
|
||||||
})
|
})
|
||||||
in
|
in
|
||||||
|
|
Loading…
Reference in New Issue