Skip to content

Commit

Permalink
Change Package.Name.t to interned type
Browse files Browse the repository at this point in the history
  • Loading branch information
rgrinberg committed Mar 3, 2018
1 parent ff05369 commit 7c287a5
Show file tree
Hide file tree
Showing 10 changed files with 36 additions and 32 deletions.
8 changes: 5 additions & 3 deletions bin/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -528,9 +528,11 @@ let resolve_package_install setup pkg =
match Main.package_install_file setup pkg with
| Ok path -> path
| Error () ->
die "Unknown package %s!%s" (pkg :> string)
(hint (pkg :> string)
((Package.Name.Map.keys setup.packages) :> string list))
let pkg = Package.Name.to_string pkg in
die "Unknown package %s!%s" pkg
(hint pkg
(Package.Name.Map.keys setup.packages
|> List.map ~f:Package.Name.to_string))

let target_hint (setup : Main.setup) path =
assert (Path.is_local path);
Expand Down
2 changes: 1 addition & 1 deletion src/install.ml
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ module Section = struct
end

let install_dir t ~(package : Package.Name.t) =
let package = (package :> string) in
let package = Package.Name.to_string package in
match t with
| Bin -> Paths.bin
| Sbin -> Paths.sbin
Expand Down
8 changes: 4 additions & 4 deletions src/install_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ module Gen(P : Install_params) = struct
|> 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 :> string) in
let meta_fn = "META." ^ (Package.Name.to_string pkg.name) in

let meta_template = Path.relative path (meta_fn ^ ".template" ) in
let meta = Path.relative path meta_fn in
Expand All @@ -79,7 +79,7 @@ module Gen(P : Install_params) = struct
~else_:(loop rest)
in
loop
[ (pkg.name :> string) ^ ".version"
[ (Package.Name.to_string pkg.name) ^ ".version"
; "version"
; "VERSION"
]
Expand All @@ -95,7 +95,7 @@ module Gen(P : Install_params) = struct
let meta_contents =
version >>^ fun version ->
Gen_meta.gen
~package:(pkg.name :> string)
~package:(Package.Name.to_string pkg.name)
~version
libs
in
Expand Down Expand Up @@ -233,7 +233,7 @@ module Gen(P : Install_params) = struct
Install.Entry.make Lib opam ~dst:"opam" :: entries
in
let entries =
let meta_fn = "META." ^ (package :> string) in
let meta_fn = "META." ^ (Package.Name.to_string package) in
let meta = Path.append ctx.build_dir (Path.relative package_path meta_fn) in
Install.Entry.make Lib meta ~dst:"META" :: entries
in
Expand Down
16 changes: 10 additions & 6 deletions src/jbuild.ml
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ module Scope_info = struct
in
let root = pkg.path in
List.iter rest ~f:(fun pkg -> assert (pkg.Package.path = root));
{ name = Some (name :> string)
{ name = Some (Package.Name.to_string name)
; packages =
Package.Name.Map.of_list_exn (List.map pkgs ~f:(fun pkg ->
pkg.Package.name, pkg))
Expand All @@ -118,11 +118,13 @@ module Scope_info = struct

let package_listing packages =
let longest_pkg =
String.longest_map packages ~f:(fun p -> (p.Package.name :> string))
String.longest_map packages ~f:(fun p ->
Package.Name.to_string p.Package.name)
in
String.concat ~sep:"\n"
(List.map packages ~f:(fun pkg ->
sprintf "- %-*s (because of %s)" longest_pkg (pkg.Package.name :> string)
sprintf "- %-*s (because of %s)" longest_pkg
(Package.Name.to_string pkg.Package.name)
(Path.to_string (Package.opam_file pkg))))

let default t =
Expand All @@ -149,22 +151,24 @@ module Scope_info = struct
| Some pkg ->
Ok pkg
| None ->
let name_s = Package.Name.to_string name in
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 :> string) (Package.Name.opam_fn name))
name_s (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 :> string)
name_s
(package_listing (Package.Name.Map.values t.packages))
(hint (name :> string) (Package.Name.Map.keys t.packages :> string list)))
(hint name_s (Package.Name.Map.keys t.packages
|> List.map ~f:Package.Name.to_string)))

let package t sexp =
match resolve t (Package.Name.of_string (string sexp)) with
Expand Down
2 changes: 1 addition & 1 deletion src/jbuild_load.ml
Original file line number Diff line number Diff line change
Expand Up @@ -201,7 +201,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
| [pkg] -> pkg
| _ ->
die "Too many opam files for package %S:\n%s"
(name :> string)
(Package.Name.to_string name)
(String.concat ~sep:"\n"
(List.map pkgs ~f:(fun pkg ->
sprintf "- %s" (Path.to_string (Package.opam_file pkg))))))
Expand Down
10 changes: 6 additions & 4 deletions src/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -31,11 +31,13 @@ let setup ?(log=Log.no_log)
Option.iter only_packages ~f:(fun set ->
Package.Name.Set.iter set ~f:(fun pkg ->
if not (Package.Name.Map.mem conf.packages pkg) then
let pkg_name = Package.Name.to_string pkg in
die "@{<error>Error@}: I don't know about package %s \
(passed through --only-packages/--release)%s"
(pkg :> string)
(hint (pkg :> string)
(Package.Name.Map.keys conf.packages :> string list))));
pkg_name
(hint pkg_name
(Package.Name.Map.keys conf.packages
|> List.map ~f:Package.Name.to_string))));
let workspace =
match workspace with
| Some w -> w
Expand Down Expand Up @@ -96,7 +98,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 :> string))
| Error () -> die "Unknown package %S" (Package.Name.to_string pkg))
in
match String_map.find setup.stanzas "default" with
| None -> die "You need to set a default context to use external-lib-deps"
Expand Down
11 changes: 4 additions & 7 deletions src/package.ml
Original file line number Diff line number Diff line change
@@ -1,15 +1,12 @@

module Name = struct
type t = string
include Interned.Make()

let of_string x = x
let of_string = make

let opam_fn t = t ^ ".opam"
let opam_fn (t : t) = to_string t ^ ".opam"

module Map = Import.String_map
module Set = Import.String_set

let pp = Format.pp_print_string
let pp fmt t = Format.pp_print_string fmt (to_string t)
end


Expand Down
7 changes: 3 additions & 4 deletions src/package.mli
Original file line number Diff line number Diff line change
@@ -1,16 +1,15 @@
(** Information about a package defined in the workspace *)

module Name : sig
type t = private string
type t

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

include Interned.S with type t := t
end

type t =
Expand Down
2 changes: 1 addition & 1 deletion src/super_context.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 :> string))
(sprintf "%s.version.sexp" (Package.Name.to_string p.name))
in
Build.Vspec.T (fn, (module V))

Expand Down
2 changes: 1 addition & 1 deletion src/utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,7 @@ let g () =
[]

let install_file ~(package : Package.Name.t) ~findlib_toolchain =
let package = (package :> string) in
let package = Package.Name.to_string package in
match findlib_toolchain with
| None -> package ^ ".install"
| Some x -> sprintf "%s-%s.install" package x
Expand Down

0 comments on commit 7c287a5

Please sign in to comment.