matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Make Dune_project.t abstract 

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-21 13:12:28 +03:00
parent 5b6496fac1
commit 83d43ecc42
9 changed files with 45 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/dir_contents.ml
View File

@ -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 ||

15
src/dune_file.ml
View File

@ -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

18
src/dune_project.ml
View File

@ -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"

17
src/dune_project.mli
View File

@ -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

2
src/install_rules.ml
View File

@ -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

4
src/jbuild_load.ml
View File

@ -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

2
src/lib.ml
View File

@ -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
View File

@ -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;

5
src/super_context.ml
View File

@ -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