Collect projects in the file tree directly (#774)
This commit is contained in:
parent
d444aeefea
commit
60c7f6fde4
|
@ -1,9 +1,18 @@
|
||||||
open Import
|
open Import
|
||||||
open Sexp.Of_sexp
|
open Sexp.Of_sexp
|
||||||
|
|
||||||
|
module Lang = struct
|
||||||
|
type t =
|
||||||
|
| Jbuilder
|
||||||
|
| Dune of Syntax.Version.t
|
||||||
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ name : string
|
{ lang : Lang.t
|
||||||
; version : string option
|
; name : string
|
||||||
|
; root : Path.t
|
||||||
|
; version : string option
|
||||||
|
; packages : Package.t Package.Name.Map.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let filename = "dune-project"
|
let filename = "dune-project"
|
||||||
|
@ -24,19 +33,68 @@ let lang =
|
||||||
in
|
in
|
||||||
field_multi "lang" (name @> version @> nil) (fun () v -> v)
|
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
|
field_o "name" string >>= function
|
||||||
| Some s -> return s
|
| 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
|
record
|
||||||
(lang >>= fun Dune_0_1 ->
|
(lang >>= fun Dune_0_1 ->
|
||||||
name ~dir >>= fun name ->
|
name ~dir ~packages >>= fun name ->
|
||||||
field_o "version" string >>= fun version ->
|
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 fname = Path.relative dir filename in
|
||||||
let sexp = Io.Sexp.load_many_as_one fname 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
|
||||||
|
|
|
@ -2,12 +2,23 @@
|
||||||
|
|
||||||
open Import
|
open Import
|
||||||
|
|
||||||
|
module Lang : sig
|
||||||
|
type t =
|
||||||
|
| Jbuilder
|
||||||
|
| Dune of Syntax.Version.t
|
||||||
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ name : string
|
{ lang : Lang.t
|
||||||
; version : string option
|
; 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" *)
|
(** "dune-project" *)
|
||||||
val filename : string
|
val filename : string
|
||||||
|
|
|
@ -110,6 +110,7 @@ module Dir = struct
|
||||||
{ files : String.Set.t
|
{ files : String.Set.t
|
||||||
; sub_dirs : t String.Map.t
|
; sub_dirs : t String.Map.t
|
||||||
; dune_file : Dune_file.t option
|
; dune_file : Dune_file.t option
|
||||||
|
; project : Dune_project.t option
|
||||||
}
|
}
|
||||||
|
|
||||||
let contents t = Lazy.force t.contents
|
let contents t = Lazy.force t.contents
|
||||||
|
@ -120,6 +121,7 @@ module Dir = struct
|
||||||
let files t = (contents t).files
|
let files t = (contents t).files
|
||||||
let sub_dirs t = (contents t).sub_dirs
|
let sub_dirs t = (contents t).sub_dirs
|
||||||
let dune_file t = (contents t).dune_file
|
let dune_file t = (contents t).dune_file
|
||||||
|
let project t = (contents t).project
|
||||||
|
|
||||||
let file_paths t =
|
let file_paths t =
|
||||||
Path.Set.of_string_set (files t) ~f:(Path.relative t.path)
|
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] = '#')
|
(fn.[0] = '.' && fn.[1] = '#')
|
||||||
|
|
||||||
let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
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 contents = lazy (
|
||||||
let files, sub_dirs =
|
let files, sub_dirs =
|
||||||
Path.readdir path
|
Path.readdir path
|
||||||
|
@ -169,6 +171,11 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
||||||
Left fn)
|
Left fn)
|
||||||
in
|
in
|
||||||
let files = String.Set.of_list files 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 =
|
let dune_file, ignored_subdirs =
|
||||||
if ignored then
|
if ignored then
|
||||||
(None, String.Set.empty)
|
(None, String.Set.empty)
|
||||||
|
@ -202,16 +209,16 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
||||||
|| String.Set.mem ignored_subdirs fn
|
|| String.Set.mem ignored_subdirs fn
|
||||||
|| Path.Set.mem extra_ignored_subtrees path
|
|| Path.Set.mem extra_ignored_subtrees path
|
||||||
in
|
in
|
||||||
String.Map.add acc fn (walk path ~ignored))
|
String.Map.add acc fn (walk path ~project ~ignored))
|
||||||
in
|
in
|
||||||
{ Dir. files; sub_dirs; dune_file })
|
{ Dir. files; sub_dirs; dune_file; project })
|
||||||
in
|
in
|
||||||
{ path
|
{ path
|
||||||
; contents
|
; contents
|
||||||
; ignored
|
; ignored
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
let root = walk path ~ignored:false in
|
let root = walk path ~ignored:false ~project:None in
|
||||||
let dirs = Hashtbl.create 1024 in
|
let dirs = Hashtbl.create 1024 in
|
||||||
Hashtbl.add dirs Path.root root;
|
Hashtbl.add dirs Path.root root;
|
||||||
{ root; dirs }
|
{ root; dirs }
|
||||||
|
|
|
@ -43,6 +43,9 @@ module Dir : sig
|
||||||
|
|
||||||
(** Return the contents of the dune (or jbuild) file in this directory *)
|
(** Return the contents of the dune (or jbuild) file in this directory *)
|
||||||
val dune_file : t -> Dune_file.t option
|
val dune_file : t -> Dune_file.t option
|
||||||
|
|
||||||
|
(** Return the project this directory is part of *)
|
||||||
|
val project : t -> Dune_project.t option
|
||||||
end
|
end
|
||||||
|
|
||||||
(** A [t] value represent a view of the source tree. It is lazily
|
(** A [t] value represent a view of the source tree. It is lazily
|
||||||
|
|
|
@ -110,6 +110,7 @@ module Scope_info = struct
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
; root : Path.t
|
; root : Path.t
|
||||||
; version : string option
|
; version : string option
|
||||||
|
; project : Dune_project.t option
|
||||||
}
|
}
|
||||||
|
|
||||||
let anonymous =
|
let anonymous =
|
||||||
|
@ -117,24 +118,16 @@ module Scope_info = struct
|
||||||
; packages = Package.Name.Map.empty
|
; packages = Package.Name.Map.empty
|
||||||
; root = Path.root
|
; root = Path.root
|
||||||
; version = None
|
; version = None
|
||||||
|
; project = None
|
||||||
}
|
}
|
||||||
|
|
||||||
let make ?version = function
|
let make (project : Dune_project.t) =
|
||||||
| [] -> anonymous
|
{ name = Some project.name
|
||||||
| pkg :: rest as pkgs ->
|
; packages = project.packages
|
||||||
let name =
|
; root = project.root
|
||||||
List.fold_left rest ~init:pkg.Package.name ~f:(fun acc pkg ->
|
; version = project.version
|
||||||
min acc pkg.Package.name)
|
; project = Some project
|
||||||
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 package_listing packages =
|
let package_listing packages =
|
||||||
let longest_pkg =
|
let longest_pkg =
|
||||||
|
|
|
@ -29,9 +29,10 @@ module Scope_info : sig
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
; root : Path.t
|
; root : Path.t
|
||||||
; version : string option
|
; 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
|
(** The anonymous represent the scope at the root of the workspace
|
||||||
when the root of the workspace contains no [<package>.opam]
|
when the root of the workspace contains no [<package>.opam]
|
||||||
|
|
|
@ -184,73 +184,31 @@ let interpret ~dir ~scope ~ignore_promoted_rules
|
||||||
|
|
||||||
let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
||||||
let ftree = File_tree.load Path.root ?extra_ignored_subtrees in
|
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 =
|
let projects =
|
||||||
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[]
|
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[]
|
||||||
~f:(fun dir acc ->
|
~f:(fun dir acc ->
|
||||||
let path = File_tree.Dir.path dir in
|
match File_tree.Dir.project dir with
|
||||||
let files = File_tree.Dir.files dir in
|
| Some p when p.root = File_tree.Dir.path dir -> p :: acc
|
||||||
if String.Set.mem files Dune_project.filename then begin
|
| _ -> acc)
|
||||||
(path, Dune_project.load ~dir:path) :: acc
|
in
|
||||||
end else
|
let packages =
|
||||||
acc)
|
List.fold_left projects ~init:Package.Name.Map.empty
|
||||||
|> Path.Map.of_list_exn
|
~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
|
in
|
||||||
let scopes =
|
let scopes =
|
||||||
Path.Map.merge scopes projects ~f:(fun path scope project ->
|
List.map projects ~f:(fun (p : Dune_project.t) ->
|
||||||
match scope, project with
|
(p.root, Scope_info.make p))
|
||||||
| None, None -> assert false
|
|> Path.Map.of_list_exn
|
||||||
| 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
|
|
||||||
})
|
|
||||||
in
|
in
|
||||||
|
|
||||||
let scopes =
|
let scopes =
|
||||||
|
|
Loading…
Reference in New Issue