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

Introduce package name private type

This commit is contained in:
Rudi Grinberg 2018-03-03 01:44:03 +07:00
parent e4aac2da97
commit ff05369868
18 changed files with 118 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
bin/main.ml
View File

@ -15,7 +15,7 @@ type common =
; workspace_file : string option
; root : string
; target_prefix : string
; only_packages : String_set.t option
; only_packages : Package.Name.Set.t option
; capture_outputs : bool
; x : string option
; diff_command : string option
@ -159,6 +159,9 @@ let find_root () =
| None -> assert false
| Some (_, dir, to_cwd) -> (dir, to_cwd)
let package_name =
Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp)
let common_footer =
`Blocks
[ `S "BUGS"
@ -253,7 +256,8 @@ let common =
; ignore_promoted_rules
; only_packages =
Option.map only_packages
~f:(fun s -> String_set.of_list (String.split s ~on:','))
~f:(fun s -> Package.Name.Set.of_list (
List.map ~f:Package.Name.of_string (String.split s ~on:',')))
; x
; config
}
@ -524,7 +528,9 @@ let resolve_package_install setup pkg =
match Main.package_install_file setup pkg with
| Ok path -> path
| Error () ->
die "Unknown package %s!%s" pkg (hint pkg (String_map.keys setup.packages))
die "Unknown package %s!%s" (pkg :> string)
(hint (pkg :> string)
((Package.Name.Map.keys setup.packages) :> string list))
let target_hint (setup : Main.setup) path =
assert (Path.is_local path);
@ -946,7 +952,7 @@ let install_uninstall ~what =
(Main.setup ~log common >>= fun setup ->
let pkgs =
match pkgs with
| [] -> String_map.keys setup.packages
| [] -> Package.Name.Map.keys setup.packages
| l -> l
in
let install_files, missing_install_files =
@ -1018,7 +1024,7 @@ let install_uninstall ~what =
is specified the default is $(i,\\$prefix/lib), otherwise \
it is the output of $(b,ocamlfind printconf destdir)"
)
$ Arg.(value & pos_all string [] name_))
$ Arg.(value & pos_all package_name [] name_))
, Term.info what ~doc ~man:help_secs)
let install = install_uninstall ~what:"install"

6
src/gen_rules.ml
View File

@ -946,8 +946,8 @@ let gen ~contexts ~build_system
match only_packages with
| None -> packages
| Some pkgs ->
String_map.filter packages ~f:(fun { Package.name; _ } ->
String_set.mem pkgs name)
Package.Name.Map.filter packages ~f:(fun { Package.name; _ } ->
Package.Name.Set.mem pkgs name)
in
let sctxs = Hashtbl.create 4 in
List.iter contexts ~f:(fun c ->
@ -973,7 +973,7 @@ let gen ~contexts ~build_system
| Library { public = Some { package; _ }; _ }
| Alias { package = Some package ; _ }
| Install { package; _ } ->
String_set.mem pkgs package.name
Package.Name.Set.mem pkgs package.name
| _ -> true)))
in
Fiber.fork_and_join host stanzas >>= fun (host, stanzas) ->

2
src/gen_rules.mli
View File

@ -6,6 +6,6 @@ val gen
: contexts:Context.t list
-> build_system:Build_system.t
-> ?filter_out_optional_stanzas_with_missing_deps:bool (* default: true *)
-> ?only_packages:String_set.t
-> ?only_packages:Package.Name.Set.t
-> Jbuild_load.conf
-> (Path.t * Scope_info.t * Stanzas.t) list String_map.t Fiber.t

3
src/install.ml
View File

@ -62,7 +62,8 @@ module Section = struct
let man = Path.(relative root) "man"
end
let install_dir t ~package =
let install_dir t ~(package : Package.Name.t) =
let package = (package :> string) in
match t with
| Bin -> Paths.bin
| Sbin -> Paths.sbin

4
src/install.mli
View File

@ -28,8 +28,8 @@ module Entry : sig
val make : Section.t -> ?dst:string -> Path.t -> t
val set_src : t -> Path.t -> t
val relative_installed_path : t -> package:string -> Path.t
val add_install_prefix : t -> package:string -> prefix:Path.t -> t
val relative_installed_path : t -> package:Package.Name.t -> Path.t
val add_install_prefix : t -> package:Package.Name.t -> prefix:Path.t -> t
end
val files : Entry.t list -> Path.Set.t

28
src/install_rules.ml
View File

@ -47,16 +47,17 @@ module Gen(P : Install_params) = struct
let public_libs = Lib.DB.all (SC.public_libs sctx) in
Lib.Set.iter public_libs ~f:gen_lib_dune_file;
Lib.Set.to_list public_libs
|> List.map ~f:(fun lib -> (Findlib.root_package_name (Lib.name lib), lib))
|> String_map.of_list_multi
|> String_map.merge (SC.packages sctx) ~f:(fun _name pkg libs ->
|> List.map ~f:(fun lib ->
(Package.Name.of_string (Findlib.root_package_name (Lib.name lib)), lib))
|> Package.Name.Map.of_list_multi
|> Package.Name.Map.merge (SC.packages sctx) ~f:(fun _name pkg libs ->
let pkg = Option.value_exn pkg in
let libs = Option.value libs ~default:[] in
Some (pkg, libs))
|> String_map.iter ~f:(fun ((pkg : Package.t), libs) ->
|> Package.Name.Map.iter ~f:(fun ((pkg : Package.t), libs) ->
let path = Path.append ctx.build_dir pkg.path in
SC.on_load_dir sctx ~dir:path ~f:(fun () ->
let meta_fn = "META." ^ pkg.name in
let meta_fn = "META." ^ (pkg.name :> string) in
let meta_template = Path.relative path (meta_fn ^ ".template" ) in
let meta = Path.relative path meta_fn in
@ -78,7 +79,7 @@ module Gen(P : Install_params) = struct
~else_:(loop rest)
in
loop
[ pkg.name ^ ".version"
[ (pkg.name :> string) ^ ".version"
; "version"
; "VERSION"
]
@ -94,7 +95,7 @@ module Gen(P : Install_params) = struct
let meta_contents =
version >>^ fun version ->
Gen_meta.gen
~package:pkg.name
~package:(pkg.name :> string)
~version
libs
in
@ -228,11 +229,11 @@ module Gen(P : Install_params) = struct
acc)
in
let entries =
let opam = Path.relative package_path (package ^ ".opam") in
let opam = Path.relative package_path (Package.Name.opam_fn package) in
Install.Entry.make Lib opam ~dst:"opam" :: entries
in
let entries =
let meta_fn = "META." ^ package in
let meta_fn = "META." ^ (package :> string) in
let meta = Path.append ctx.build_dir (Path.relative package_path meta_fn) in
Install.Entry.make Lib meta ~dst:"META" :: entries
in
@ -275,17 +276,18 @@ module Gen(P : Install_params) = struct
(package.name,
Install.Entry.make section (Path.relative dir src) ?dst))
| _ -> [])
|> String_map.of_list_multi
|> Package.Name.Map.of_list_multi
in
String_map.iter (SC.packages sctx) ~f:(fun (pkg : Package.t) ->
Package.Name.Map.iter (SC.packages sctx) ~f:(fun (pkg : Package.t) ->
let stanzas =
Option.value (String_map.find entries_per_package pkg.name) ~default:[]
Option.value (Package.Name.Map.find entries_per_package pkg.name)
~default:[]
in
install_file pkg.path pkg.name stanzas)
let init_install_files () =
if not ctx.implicit then
String_map.iteri (SC.packages sctx)
Package.Name.Map.iteri (SC.packages sctx)
~f:(fun pkg { Package.path = src_path; _ } ->
let install_fn =
Utils.install_file ~package:pkg

36
src/jbuild.ml
View File

@ -90,13 +90,13 @@ module Scope_info = struct
type t =
{ name : Name.t
; packages : Package.t String_map.t
; packages : Package.t Package.Name.Map.t
; root : Path.t
}
let anonymous =
{ name = None
; packages = String_map.empty
; packages = Package.Name.Map.empty
; root = Path.root
}
@ -109,24 +109,24 @@ module Scope_info = struct
in
let root = pkg.path in
List.iter rest ~f:(fun pkg -> assert (pkg.Package.path = root));
{ name = Some name
{ name = Some (name :> string)
; packages =
String_map.of_list_exn (List.map pkgs ~f:(fun pkg ->
Package.Name.Map.of_list_exn (List.map pkgs ~f:(fun pkg ->
pkg.Package.name, pkg))
; root
}
let package_listing packages =
let longest_pkg =
String.longest_map packages ~f:(fun p -> p.Package.name)
String.longest_map packages ~f:(fun p -> (p.Package.name :> string))
in
String.concat ~sep:"\n"
(List.map packages ~f:(fun pkg ->
sprintf "- %-*s (because of %s)" longest_pkg pkg.Package.name
(Path.to_string (Path.relative pkg.path (pkg.name ^ ".opam")))))
sprintf "- %-*s (because of %s)" longest_pkg (pkg.Package.name :> string)
(Path.to_string (Package.opam_file pkg))))
let default t =
match String_map.values t.packages with
match Package.Name.Map.values t.packages with
| [pkg] -> Ok pkg
| [] ->
Error
@ -142,39 +142,39 @@ module Scope_info = struct
stanza is for. I have the choice between these ones:\n\
%s\n\
You need to add a (package ...) field in this (install ...) stanza"
(package_listing (String_map.values t.packages)))
(package_listing (Package.Name.Map.values t.packages)))
let resolve t name =
match String_map.find t.packages name with
match Package.Name.Map.find t.packages name with
| Some pkg ->
Ok pkg
| None ->
if String_map.is_empty t.packages then
if Package.Name.Map.is_empty t.packages then
Error (sprintf
"You cannot declare items to be installed without \
adding a <package>.opam file at the root of your project.\n\
To declare elements to be installed as part of package %S, \
add a %S file at the root of your project."
name (name ^ ".opam"))
(name :> string) (Package.Name.opam_fn name))
else
Error (sprintf
"The current scope doesn't define package %S.\n\
The only packages for which you can declare \
elements to be installed in this directory are:\n\
%s%s"
name
(package_listing (String_map.values t.packages))
(hint name (String_map.keys t.packages)))
(name :> string)
(package_listing (Package.Name.Map.values t.packages))
(hint (name :> string) (Package.Name.Map.keys t.packages :> string list)))
let package t sexp =
match resolve t (string sexp) with
match resolve t (Package.Name.of_string (string sexp)) with
| Ok p -> p
| Error s -> Loc.fail (Sexp.Ast.loc sexp) "%s" s
let package_field t =
map_validate (field_o "package" string) ~f:(function
| None -> default t
| Some name -> resolve t name)
| Some name -> resolve t (Package.Name.of_string name))
end
@ -531,7 +531,7 @@ module Public_lib = struct
match String.split s ~on:'.' with
| [] -> assert false
| pkg :: rest ->
match Scope_info.resolve pkgs pkg with
match Scope_info.resolve pkgs (Package.Name.of_string pkg) with
| Ok pkg ->
Ok (Some
{ package = pkg

4
src/jbuild.mli
View File

@ -26,7 +26,7 @@ module Scope_info : sig
{ name : string option (** First package name in alphabetical
order. [None] for the global
scope. *)
; packages : Package.t String_map.t
; packages : Package.t Package.Name.Map.t
; root : Path.t
}
@ -39,7 +39,7 @@ module Scope_info : sig
(** [resolve t package_name] looks up [package_name] in [t] and returns the
package description if it exists, otherwise it returns an error. *)
val resolve : t -> string -> (Package.t, string) result
val resolve : t -> Package.Name.t -> (Package.t, string) result
end
(** Ppx preprocessors *)

15
src/jbuild_load.ml
View File

@ -157,7 +157,7 @@ end
type conf =
{ file_tree : File_tree.t
; jbuilds : Jbuilds.t
; packages : Package.t String_map.t
; packages : Package.t Package.Name.Map.t
; scopes : Scope_info.t list
}
@ -186,27 +186,28 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
| Some (String (_, s)) -> Some s
| _ -> None
in
(pkg,
{ Package. name = pkg
let name = Package.Name.of_string pkg in
(name,
{ Package. name
; path
; version_from_opam_file
}) :: acc
| _ -> acc))
in
let packages =
String_map.of_list_multi packages
|> String_map.mapi ~f:(fun name pkgs ->
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"
name
(name :> string)
(String.concat ~sep:"\n"
(List.map pkgs ~f:(fun pkg ->
sprintf "- %s" (Path.to_string (Package.opam_file pkg))))))
in
let scopes =
String_map.values packages
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

3
src/jbuild_load.mli
View File

@ -1,4 +1,3 @@
open Import
open Jbuild
module Jbuilds : sig
@ -13,7 +12,7 @@ end
type conf =
{ file_tree : File_tree.t
; jbuilds : Jbuilds.t
; packages : Package.t String_map.t
; packages : Package.t Package.Name.Map.t
; scopes : Scope_info.t list
}

14
src/main.ml
View File

@ -7,12 +7,12 @@ type setup =
{ build_system : Build_system.t
; stanzas : (Path.t * Jbuild.Scope_info.t * Jbuild.Stanzas.t) list String_map.t
; contexts : Context.t list
; packages : Package.t String_map.t
; packages : Package.t Package.Name.Map.t
; file_tree : File_tree.t
}
let package_install_file { packages; _ } pkg =
match String_map.find packages pkg with
match Package.Name.Map.find packages pkg with
| None -> Error ()
| Some p ->
Ok (Path.relative p.path
@ -29,11 +29,13 @@ let setup ?(log=Log.no_log)
() =
let conf = Jbuild_load.load ?extra_ignored_subtrees ?ignore_promoted_rules () in
Option.iter only_packages ~f:(fun set ->
String_set.iter set ~f:(fun pkg ->
if not (String_map.mem conf.packages pkg) then
Package.Name.Set.iter set ~f:(fun pkg ->
if not (Package.Name.Map.mem conf.packages pkg) then
die "@{<error>Error@}: I don't know about package %s \
(passed through --only-packages/--release)%s"
pkg (hint pkg (String_map.keys conf.packages))));
(pkg :> string)
(hint (pkg :> string)
(Package.Name.Map.keys conf.packages :> string list))));
let workspace =
match workspace with
| Some w -> w
@ -94,7 +96,7 @@ let external_lib_deps ?log ~packages () =
List.map packages ~f:(fun pkg ->
match package_install_file setup pkg with
| Ok path -> path
| Error () -> die "Unknown package %S" pkg)
| Error () -> die "Unknown package %S" (pkg :> string))
in
match String_map.find setup.stanzas "default" with
| None -> die "You need to set a default context to use external-lib-deps"

8
src/main.mli
View File

@ -6,12 +6,12 @@ type setup =
; (* Evaluated jbuilds per context names *)
stanzas : (Path.t * Scope_info.t * Stanzas.t) list String_map.t
; contexts : Context.t list
; packages : Package.t String_map.t
; packages : Package.t Package.Name.Map.t
; file_tree : File_tree.t
}
(* Returns [Error ()] if [pkg] is unknown *)
val package_install_file : setup -> string -> (Path.t, unit) result
val package_install_file : setup -> Package.Name.t -> (Path.t, unit) result
(** Scan the source tree and discover everything that's needed in order to build
it. *)
@ -20,14 +20,14 @@ val setup
-> ?filter_out_optional_stanzas_with_missing_deps:bool
-> ?workspace:Workspace.t
-> ?workspace_file:string
-> ?only_packages:String_set.t
-> ?only_packages:Package.Name.Set.t
-> ?x:string
-> ?ignore_promoted_rules:bool
-> unit
-> setup Fiber.t
val external_lib_deps
: ?log:Log.t
-> packages:string list
-> packages:Package.Name.t list
-> unit
-> Build.lib_deps Path.Map.t

19
src/package.ml
View File

@ -1,7 +1,22 @@
module Name = struct
type t = string
let of_string x = x
let opam_fn t = t ^ ".opam"
module Map = Import.String_map
module Set = Import.String_set
let pp = Format.pp_print_string
end
type t =
{ name : string
{ name : Name.t
; path : Path.t
; version_from_opam_file : string option
}
let opam_file t = Path.relative t.path (t.name ^ ".opam")
let opam_file t = Path.relative t.path (Name.opam_fn t.name)

15
src/package.mli
View File

@ -1,7 +1,20 @@
(** Information about a package defined in the workspace *)
module Name : sig
type t = private string
val of_string : string -> t
val opam_fn : t -> string
module Map : Stdune.Map.S with type key = t
module Set : Stdune.Set.S with type elt = t
val pp : Format.formatter -> t -> unit
end
type t =
{ name : string
{ name : Name.t
; path : Path.t
; version_from_opam_file : string option
}

7
src/super_context.ml
View File

@ -21,7 +21,7 @@ type t =
; public_libs : Lib.DB.t
; installed_libs : Lib.DB.t
; stanzas : Dir_with_jbuild.t list
; packages : Package.t String_map.t
; packages : Package.t Package.Name.Map.t
; file_tree : File_tree.t
; artifacts : Artifacts.t
; stanzas_to_consider_for_install : (Path.t * Scope.t * Stanza.t) list
@ -336,7 +336,7 @@ module Pkg_version = struct
let spec sctx (p : Package.t) =
let fn =
Path.relative (Path.append sctx.context.build_dir p.path)
(sprintf "%s.version.sexp" p.name)
(sprintf "%s.version.sexp" (p.name :> string))
in
Build.Vspec.T (fn, (module V))
@ -462,7 +462,8 @@ module Action = struct
Some (str_exp (string_of_bool (
Lib.DB.available (Scope.libs scope) lib)))
| Some ("version", s) -> begin
match Scope_info.resolve (Scope.info scope) s with
match Scope_info.resolve (Scope.info scope)
(Package.Name.of_string s) with
| Ok p ->
let x =
Pkg_version.read sctx p >>^ function

4
src/super_context.mli
View File

@ -25,7 +25,7 @@ val create
-> ?host:t
-> scopes:Scope_info.t list
-> file_tree:File_tree.t
-> packages:Package.t String_map.t
-> packages:Package.t Package.Name.Map.t
-> stanzas:(Path.t * Scope_info.t * Stanzas.t) list
-> filter_out_optional_stanzas_with_missing_deps:bool
-> build_system:Build_system.t
@ -33,7 +33,7 @@ val create
val context : t -> Context.t
val stanzas : t -> Dir_with_jbuild.t list
val packages : t -> Package.t String_map.t
val packages : t -> Package.t Package.Name.Map.t
val file_tree : t -> File_tree.t
val artifacts : t -> Artifacts.t
val stanzas_to_consider_for_install : t -> (Path.t * Scope.t * Stanza.t) list

3
src/utils.ml
View File

@ -142,7 +142,8 @@ let g () =
else
[]
let install_file ~package ~findlib_toolchain =
let install_file ~(package : Package.Name.t) ~findlib_toolchain =
let package = (package :> string) in
match findlib_toolchain with
| None -> package ^ ".install"
| Some x -> sprintf "%s-%s.install" package x

5
src/utils.mli
View File

@ -53,7 +53,10 @@ val library_not_found : ?context:string -> ?hint:string -> string -> _
(** [\["-g"\]] if [!Clflags.g] and [\[\]] otherwise *)
val g : unit -> string list
val install_file : package:string -> findlib_toolchain:string option -> string
val install_file
: package:Package.Name.t
-> findlib_toolchain:string option
-> string
(** Digest files with caching *)
module Cached_digest : sig