Introduce package name private type

bin/main.ml

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

src/gen_rules.ml

@@ -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; _ } ->
+      Package.Name.Map.filter packages ~f:(fun { Package.name; _ } ->
-        String_set.mem pkgs 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) ->

src/gen_rules.mli

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

src/install.ml

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

src/install.mli

@@ -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 relative_installed_path : t -> package:Package.Name.t -> Path.t
-  val add_install_prefix : t -> package:string -> prefix:Path.t -> t
+  val add_install_prefix : t -> package:Package.Name.t -> prefix:Path.t -> t
 end
 
 val files : Entry.t list -> Path.Set.t

src/install_rules.ml

@@ -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))
+    |> List.map ~f:(fun lib ->
-    |> String_map.of_list_multi
+      (Package.Name.of_string (Findlib.root_package_name (Lib.name lib)), lib))
-    |> String_map.merge (SC.packages sctx) ~f:(fun _name pkg libs ->
+    |> 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

src/jbuild.ml

@@ -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
+         sprintf "- %-*s (because of %s)" longest_pkg (pkg.Package.name :> string)
-           (Path.to_string (Path.relative pkg.path (pkg.name ^ ".opam")))))
+           (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
+                 (name :> string)
-                 (package_listing (String_map.values t.packages))
+                 (package_listing (Package.Name.Map.values t.packages))
-                 (hint name (String_map.keys 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

src/jbuild.mli

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

src/jbuild_load.ml

@@ -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,
+          let name = Package.Name.of_string pkg in
-           { Package. name = pkg
+          (name,
+           { Package. name
            ; path
            ; version_from_opam_file
            }) :: acc
         | _ -> acc))
   in
   let packages =
-    String_map.of_list_multi packages
+    Package.Name.Map.of_list_multi packages
-    |> String_map.mapi ~f:(fun name pkgs ->
+    |> 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

src/jbuild_load.mli

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

src/main.ml

@@ -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 ->
+    Package.Name.Set.iter set ~f:(fun pkg ->
-      if not (String_map.mem conf.packages pkg) then
+      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"

src/main.mli

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

src/package.ml

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

src/package.mli

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

src/super_context.ml

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

src/super_context.mli

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

src/utils.ml

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

src/utils.mli

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