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

Collect projects in the file tree directly (#774)

This commit is contained in:
Jérémie Dimino 2018-05-15 09:46:07 +01:00 committed by GitHub
parent d444aeefea
commit 60c7f6fde4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 126 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
src/dune_project.ml
View File

@ -1,9 +1,18 @@
open Import
open Sexp.Of_sexp
module Lang = struct
type t =
| Jbuilder
| Dune of Syntax.Version.t
end
type t =
{ name : string
; version : string option
{ lang : Lang.t
; name : string
; root : Path.t
; version : string option
; packages : Package.t Package.Name.Map.t
}
let filename = "dune-project"
@ -24,19 +33,68 @@ let lang =
in
field_multi "lang" (name @> version @> nil) (fun () v -> v)
let name ~dir =
let default_name ~dir ~packages =
match Package.Name.Map.choose packages with
| None ->
"_" ^ String.concat ~sep:"_" (Path.explode_exn dir)
| Some (name, _) ->
Package.Name.to_string
(Package.Name.Map.fold packages ~init:name ~f:(fun pkg acc ->
min acc pkg.Package.name))
let name ~dir ~packages =
field_o "name" string >>= function
| Some s -> return s
| None -> return ("_" ^ String.concat ~sep:"_" (Path.explode_exn dir))
| None -> return (default_name ~dir ~packages)
let parse ~dir =
let parse ~dir packages =
record
(lang >>= fun Dune_0_1 ->
name ~dir >>= fun name ->
name ~dir ~packages >>= fun name ->
field_o "version" string >>= fun version ->
return { name; version })
return { lang = Dune (0, 1)
; name
; root = dir
; version
; packages
})
let load ~dir =
let load_dune_project ~dir packages =
let fname = Path.relative dir filename in
let sexp = Io.Sexp.load_many_as_one fname in
parse ~dir sexp
parse ~dir packages sexp
let make_jbuilder_project ~dir packages =
{ lang = Jbuilder
; name = default_name ~dir ~packages
; root = dir
; version = None
; packages
}
let load ~dir ~files =
let packages =
String.Set.fold files ~init:[] ~f:(fun fn acc ->
match Filename.split_extension fn with
| (pkg, ".opam") when pkg <> "" ->
let version_from_opam_file =
let opam = Opam_file.load (Path.relative dir fn) in
match Opam_file.get_field opam "version" with
| Some (String (_, s)) -> Some s
| _ -> None
in
let name = Package.Name.of_string pkg in
(name,
{ Package. name
; path = dir
; version_from_opam_file
}) :: acc
| _ -> acc)
|> Package.Name.Map.of_list_exn
in
if String.Set.mem files filename then
Some (load_dune_project ~dir packages)
else if not (Package.Name.Map.is_empty packages) then
Some (make_jbuilder_project ~dir packages)
else
None

17
src/dune_project.mli
View File

@ -2,12 +2,23 @@
open Import
module Lang : sig
type t =
| Jbuilder
| Dune of Syntax.Version.t
end
type t =
{ name : string
; version : string option
{ lang : Lang.t
; name : string
; root : Path.t
; version : string option
; packages : Package.t Package.Name.Map.t
}
val load : dir:Path.t -> t
(** Load a project description from the following directory. [files]
is the set of files in this directory. *)
val load : dir:Path.t -> files:String.Set.t -> t option
(** "dune-project" *)
val filename : string

15
src/file_tree.ml
View File

@ -110,6 +110,7 @@ module Dir = struct
{ files : String.Set.t
; sub_dirs : t String.Map.t
; dune_file : Dune_file.t option
; project : Dune_project.t option
}
let contents t = Lazy.force t.contents
@ -120,6 +121,7 @@ module Dir = struct
let files t = (contents t).files
let sub_dirs t = (contents t).sub_dirs
let dune_file t = (contents t).dune_file
let project t = (contents t).project
let file_paths t =
Path.Set.of_string_set (files t) ~f:(Path.relative t.path)
@ -154,7 +156,7 @@ let ignore_file fn ~is_directory =
(fn.[0] = '.' && fn.[1] = '#')
let load ?(extra_ignored_subtrees=Path.Set.empty) path =
let rec walk path ~ignored : Dir.t =
let rec walk path ~project ~ignored : Dir.t =
let contents = lazy (
let files, sub_dirs =
Path.readdir path
@ -169,6 +171,11 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
Left fn)
in
let files = String.Set.of_list files in
let project =
match Dune_project.load ~dir:path ~files with
| Some _ as x -> x
| None -> project
in
let dune_file, ignored_subdirs =
if ignored then
(None, String.Set.empty)
@ -202,16 +209,16 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|| String.Set.mem ignored_subdirs fn
|| Path.Set.mem extra_ignored_subtrees path
in
String.Map.add acc fn (walk path ~ignored))
String.Map.add acc fn (walk path ~project ~ignored))
in
{ Dir. files; sub_dirs; dune_file })
{ Dir. files; sub_dirs; dune_file; project })
in
{ path
; contents
; ignored
}
in
let root = walk path ~ignored:false in
let root = walk path ~ignored:false ~project:None in
let dirs = Hashtbl.create 1024 in
Hashtbl.add dirs Path.root root;
{ root; dirs }

3
src/file_tree.mli
View File

@ -43,6 +43,9 @@ module Dir : sig
(** Return the contents of the dune (or jbuild) file in this directory *)
val dune_file : t -> Dune_file.t option
(** Return the project this directory is part of *)
val project : t -> Dune_project.t option
end
(** A [t] value represent a view of the source tree. It is lazily

25
src/jbuild.ml
View File

@ -110,6 +110,7 @@ module Scope_info = struct
; packages : Package.t Package.Name.Map.t
; root : Path.t
; version : string option
; project : Dune_project.t option
}
let anonymous =
@ -117,24 +118,16 @@ module Scope_info = struct
; packages = Package.Name.Map.empty
; root = Path.root
; version = None
; project = None
}
let make ?version = function
| [] -> anonymous
| pkg :: rest as pkgs ->
let name =
List.fold_left rest ~init:pkg.Package.name ~f:(fun acc pkg ->
min acc pkg.Package.name)
in
let root = pkg.path in
List.iter rest ~f:(fun pkg -> assert (pkg.Package.path = root));
{ name = Some (Package.Name.to_string name)
; packages =
Package.Name.Map.of_list_exn (List.map pkgs ~f:(fun pkg ->
pkg.Package.name, pkg))
; root
; version
}
let make (project : Dune_project.t) =
{ name = Some project.name
; packages = project.packages
; root = project.root
; version = project.version
; project = Some project
}
let package_listing packages =
let longest_pkg =

3
src/jbuild.mli
View File

@ -29,9 +29,10 @@ module Scope_info : sig
; packages : Package.t Package.Name.Map.t
; root : Path.t
; version : string option
; project : Dune_project.t option
}
val make : ?version:string -> Package.t list -> t
val make : Dune_project.t -> t
(** The anonymous represent the scope at the root of the workspace
when the root of the workspace contains no [<package>.opam]

82
src/jbuild_load.ml
View File

@ -184,73 +184,31 @@ let interpret ~dir ~scope ~ignore_promoted_rules
let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
let ftree = File_tree.load Path.root ?extra_ignored_subtrees in
let packages =
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
let path = File_tree.Dir.path dir in
let files = File_tree.Dir.files dir in
String.Set.fold files ~init:pkgs ~f:(fun fn acc ->
match Filename.split_extension fn with
| (pkg, ".opam") when pkg <> "" ->
let version_from_opam_file =
let opam = Opam_file.load (Path.relative path fn) in
match Opam_file.get_field opam "version" with
| Some (String (_, s)) -> Some s
| _ -> None
in
let name = Package.Name.of_string pkg in
(name,
{ Package. name
; path
; version_from_opam_file
}) :: acc
| _ -> acc))
in
let packages =
Package.Name.Map.of_list_multi packages
|> Package.Name.Map.mapi ~f:(fun name pkgs ->
match pkgs with
| [pkg] -> pkg
| _ ->
die "Too many opam files for package %S:\n%s"
(Package.Name.to_string name)
(String.concat ~sep:"\n"
(List.map pkgs ~f:(fun pkg ->
sprintf "- %s" (Path.to_string (Package.opam_file pkg))))))
in
let scopes =
Package.Name.Map.values packages
|> List.map ~f:(fun pkg -> (pkg.Package.path, pkg))
|> Path.Map.of_list_multi
|> Path.Map.map ~f:Scope_info.make
in
let projects =
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[]
~f:(fun dir acc ->
let path = File_tree.Dir.path dir in
let files = File_tree.Dir.files dir in
if String.Set.mem files Dune_project.filename then begin
(path, Dune_project.load ~dir:path) :: acc
end else
acc)
|> Path.Map.of_list_exn
match File_tree.Dir.project dir with
| Some p when p.root = File_tree.Dir.path dir -> 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 ->
match a, b with
| None, None -> None
| None, Some _ -> b
| Some _, None -> a
| Some a, Some b ->
die "Too many opam files for package %S:\n- %s\n- %s"
(Package.Name.to_string name)
(Path.to_string_maybe_quoted (Package.opam_file a))
(Path.to_string_maybe_quoted (Package.opam_file b))))
in
let scopes =
Path.Map.merge scopes projects ~f:(fun path scope project ->
match scope, project with
| None, None -> assert false
| Some _, None -> scope
| None, Some { name; version } ->
Some { name = Some name
; packages = Package.Name.Map.empty
; root = path
; version
}
| Some scope, Some { name; version } ->
Some { scope with
name = Some name
; version
})
List.map projects ~f:(fun (p : Dune_project.t) ->
(p.root, Scope_info.make p))
|> Path.Map.of_list_exn
in
let scopes =