One Directory per Package (#12614)

* Return package id instead of the entire package

In future work, we'd like to introduce a package to every single stanza,
but doing that naively will create cycles.

* refactor: move Package.Id to own module

to break some cycles

* feature: Add a dir stanza to packages

The dir stanza allows us to associate a directory tree with a particular
package. This gives us two new facts:

1. If a stanza exists under this directory tree, it must belong to said
   package

2. If a stanza exists under another directory tree, it cannot belong to
   said package.

Signed-off-by: Rudi Grinberg <[email protected]>

Author: rgrinberg

bin/dune_init.ml

@@ -59,8 +59,8 @@ module File = struct
       | _ -> false
     ;;
 
-    let csts_conflict project (a : Cst.t) (b : Cst.t) =
-      let of_ast = Dune_rules.Stanzas.of_ast project in
+    let csts_conflict project ~dir (a : Cst.t) (b : Cst.t) =
+      let of_ast = Dune_rules.Stanzas.of_ast project ~dir in
       (let open Option.O in
        let* a_ast = Cst.abstract a in
        let+ b_ast = Cst.abstract b in
@@ -71,19 +71,19 @@ module File = struct
     ;;
 
     (* TODO(shonfeder): replace with stanza merging *)
-    let find_conflicting project new_stanzas existing_stanzas =
+    let find_conflicting project ~dir new_stanzas existing_stanzas =
       let conflicting_stanza stanza =
-        match List.find ~f:(csts_conflict project stanza) existing_stanzas with
+        match List.find ~f:(csts_conflict ~dir project stanza) existing_stanzas with
         | Some conflict -> Some (stanza, conflict)
         | None -> None
       in
       List.find_map ~f:conflicting_stanza new_stanzas
     ;;
 
-    let add (project : Dune_project.t) stanzas = function
+    let add (project : Dune_project.t) ~dir stanzas = function
       | Text f -> Text f (* Adding a stanza to a text file isn't meaningful *)
       | Dune f ->
-        (match find_conflicting project stanzas f.content with
+        (match find_conflicting project ~dir stanzas f.content with
          | None -> Dune { f with content = f.content @ stanzas }
          | Some (a, b) ->
            User_error.raise
@@ -430,6 +430,7 @@ module Component = struct
                 ; constraint_ = None
                 }
               ]
+            ~contents_basename:None
         in
         let packages = Package.Name.Map.singleton (Package.name package) package in
         let info =
@@ -457,7 +458,7 @@ module Component = struct
 
   (* TODO Support for merging in changes to an existing stanza *)
   let add_stanza_to_dune_file ~(project : Dune_project.t) ~dir stanza =
-    File.load_dune_file ~dir |> File.Stanza.add project stanza
+    File.load_dune_file ~dir |> File.Stanza.add ~dir project stanza
   ;;
 
   (* Functions to make the various components, represented as lists of files *)
@@ -466,7 +467,7 @@ module Component = struct
       let dir = context.dir in
       let bin_dune =
         Stanza_cst.executable common options
-        |> add_stanza_to_dune_file ~project:context.project ~dir
+        |> add_stanza_to_dune_file ~dir ~project:context.project
       in
       let bin_ml =
         let name = sprintf "%s.ml" (Dune_lang.Atom.to_string common.name) in

doc/changes/added/12614.md

@@ -0,0 +1,5 @@
+- Introduce a `(dir ..)` field on packages defined in the `dune-project`. This
+  field allows to associate a directory with a particular package. This makes
+  dune automatically filter out all stanzas in this directory and its
+  descendants with `--only-packages`. All users are recommended to switch to
+  using this field. (#12614, fixes #3255, @rgrinberg)

src/dune_lang/dune_lang.ml

@@ -62,6 +62,7 @@ module Mode_conf = Mode_conf
 module Oxcaml = Oxcaml
 module Modules_settings = Modules_settings
 module Stanza_pkg = Stanza_pkg
+module Package_mask = Package_mask
 
 (* CR-someday rgrinberg: perhaps wrap these under [Stanzas]? *)
 module Copy_files = Copy_files

src/dune_lang/dune_project.ml

@@ -73,6 +73,7 @@ type t =
   ; dune_version : Syntax.Version.t
   ; info : Package_info.t
   ; packages : Package.t Package.Name.Map.t
+  ; exclusive_dir_packages : Package_id.t Path.Source.Map.t
   ; stanza_parser : Stanza.t list Decoder.t
   ; project_file : Path.Source.t option
   ; extension_args : Univ_map.t
@@ -114,7 +115,13 @@ let packages t = t.packages
 let name t = t.name
 let version t = t.version
 let root t = t.root
-let stanza_parser t = Decoder.set key t t.stanza_parser
+
+let stanza_parser t ~dir =
+  let mask = Package_mask.package_env ~dir ~packages:t.exclusive_dir_packages in
+  let parser = Decoder.set key t t.stanza_parser in
+  Decoder.set Package_mask.key mask parser
+;;
+
 let file t = t.project_file
 
 let implicit_transitive_deps t ocaml_version =
@@ -162,6 +169,7 @@ let to_dyn
       ; expand_aliases_in_sandbox
       ; opam_file_location
       ; including_hidden_packages = _
+      ; exclusive_dir_packages = _
       }
   =
   let open Dyn in
@@ -489,6 +497,25 @@ let default_name ~dir ~(packages : Package.t Package.Name.Map.t) =
     Dune_project_name.named loc (Package.Name.to_string name)
 ;;
 
+let make_exclusive_dir_packages packages =
+  match
+    Package.Name.Map.values packages
+    |> List.filter_map ~f:(fun package ->
+      Package.exclusive_dir package
+      |> Option.map ~f:(fun (loc, dir) -> loc, dir, Package.id package))
+    |> Path.Source.Map.of_list_map ~f:(fun (_loc, dir, id) -> dir, id)
+  with
+  | Ok s -> s
+  | Error (dir, (loc, _, _), (_, _, id)) ->
+    User_error.raise
+      ~loc
+      [ Pp.textf
+          "package %s is already defined in %S"
+          (Path.Source.to_string_maybe_quoted dir)
+          (Package.Name.to_string id.name)
+      ]
+;;
+
 let infer ~dir info packages =
   let lang = get_dune_lang () in
   let name = default_name ~dir ~packages in
@@ -534,6 +561,7 @@ let infer ~dir info packages =
   ; expand_aliases_in_sandbox
   ; opam_file_location
   ; including_hidden_packages = packages
+  ; exclusive_dir_packages = make_exclusive_dir_packages packages
   }
 ;;
 
@@ -576,6 +604,7 @@ let encode : t -> Dune_sexp.t list =
       ; expand_aliases_in_sandbox
       ; opam_file_location = _
       ; including_hidden_packages = _
+      ; exclusive_dir_packages = _
       } ->
   let open Encoder in
   let lang = Lang.get_exn "dune" in
@@ -1030,6 +1059,7 @@ let parse ~dir ~(lang : Lang.Instance.t) ~file =
        ; expand_aliases_in_sandbox
        ; opam_file_location
        ; including_hidden_packages = packages
+       ; exclusive_dir_packages = make_exclusive_dir_packages packages
        }
 ;;
 

src/dune_lang/dune_project.mli

@@ -19,7 +19,7 @@ val packages : t -> Package.t Package.Name.Map.t
 val name : t -> Dune_project_name.t
 val version : t -> Package_version.t option
 val root : t -> Path.Source.t
-val stanza_parser : t -> Stanza.t list Decoder.t
+val stanza_parser : t -> dir:Path.Source.t -> Stanza.t list Decoder.t
 val generate_opam_files : t -> bool
 val set_generate_opam_files : bool -> t -> t
 

src/dune_lang/package.ml

@@ -1,33 +1,6 @@
 open Import
 module Name = Package_name
-
-module Id = struct
-  module T = struct
-    type t =
-      { name : Name.t
-      ; dir : Path.Source.t
-      }
-
-    let compare { name; dir } pkg =
-      match Name.compare name pkg.name with
-      | Eq -> Path.Source.compare dir pkg.dir
-      | e -> e
-    ;;
-
-    let to_dyn { dir; name } =
-      Dyn.record [ "name", Name.to_dyn name; "dir", Path.Source.to_dyn dir ]
-    ;;
-  end
-
-  include T
-
-  let hash { name; dir } = Tuple.T2.hash Name.hash Path.Source.hash (name, dir)
-  let name t = t.name
-
-  module C = Comparable.Make (T)
-  module Set = C.Set
-  module Map = C.Map
-end
+module Id = Package_id
 
 type opam_file =
   | Exists of bool
@@ -57,6 +30,7 @@ type t =
   ; sites : Section.t Site.Map.t
   ; allow_empty : bool
   ; original_opam_file : original_opam_file option
+  ; exclusive_dir : (Loc.t * Path.Source.t) option
   }
 
 (* Package name are globally unique, so we can reasonably expect that there will
@@ -80,6 +54,7 @@ let id t = t.id
 let original_opam_file t = t.original_opam_file
 let set_inside_opam_dir t ~dir = { t with opam_file = Name.file t.id.name ~dir }
 let set_version_and_info t ~version ~info = { t with version; info }
+let exclusive_dir t = t.exclusive_dir
 
 let encode
       (name : Name.t)
@@ -99,6 +74,7 @@ let encode
       ; allow_empty
       ; opam_file = _
       ; original_opam_file = _
+      ; exclusive_dir
       }
   =
   let open Encoder in
@@ -119,6 +95,10 @@ let encode
             (Name.Map.keys deprecated_package_names)
         ; field_l "sites" (pair Site.encode Section.encode) (Site.Map.to_list sites)
         ; field_b "allow_empty" allow_empty
+        ; field_o
+            "dir"
+            (fun (_, dir) -> Path.Source.basename dir |> Dune_sexp.atom_or_quoted_string)
+            exclusive_dir
         ]
   in
   list sexp (string "package" :: fields)
@@ -155,6 +135,11 @@ let decode =
        and+ depopts = field ~default:[] "depopts" (repeat Package_dependency.decode)
        and+ info = Package_info.decode ~since:(2, 0) ()
        and+ tags = field "tags" (enter (repeat string)) ~default:[]
+       and+ exclusive_dir =
+         field_o
+           "dir"
+           (let+ loc, s = Syntax.since Stanza.syntax (3, 21) >>> located string in
+            loc, Path.Source.relative ~error_loc:loc dir s)
        and+ deprecated_package_names =
          name_map
            (Syntax.since Stanza.syntax (2, 0))
@@ -176,7 +161,7 @@ let decode =
        and+ allow_empty = field_b "allow_empty" ~check:(Syntax.since Stanza.syntax (3, 0))
        and+ lang_version = Syntax.get_exn Stanza.syntax in
        let allow_empty = lang_version < (3, 0) || allow_empty in
-       let id = { Id.name; dir } in
+       let id = Id.create ~name ~dir in
        let opam_file = Name.file id.name ~dir:id.dir in
        { id
        ; loc
@@ -194,6 +179,7 @@ let decode =
        ; allow_empty
        ; opam_file
        ; original_opam_file = None
+       ; exclusive_dir
        }
 ;;
 
@@ -221,6 +207,7 @@ let to_dyn
       ; allow_empty
       ; opam_file = _
       ; original_opam_file = _
+      ; exclusive_dir = _
       }
   =
   let open Dyn in
@@ -264,8 +251,9 @@ let create
       ~tags
       ~original_opam_file
       ~deprecated_package_names
+      ~contents_basename
   =
-  let id = { Id.name; dir } in
+  let id = Id.create ~name ~dir in
   { id
   ; loc
   ; version
@@ -282,5 +270,7 @@ let create
   ; allow_empty
   ; opam_file = Name.file name ~dir
   ; original_opam_file
+  ; exclusive_dir =
+      Option.map contents_basename ~f:(fun (loc, s) -> loc, Path.Source.relative dir s)
   }
 ;;

src/dune_lang/package.mli

@@ -1,21 +1,14 @@
 (** Information about a package defined in the workspace *)
 
 open Import
+module Id : module type of Package_id with type t = Package_id.t
 
 module Name : sig
   type t = Package_name.t
 
   include module type of Package_name with type t := t
 end
 
-module Id : sig
-  type t
-
-  val name : t -> Name.t
-
-  include Comparable_intf.S with type key := t
-end
-
 type opam_file =
   | Exists of bool
   | Generated
@@ -27,6 +20,7 @@ val deprecated_package_names : t -> Loc.t Name.Map.t
 val sites : t -> Section.t Site.Map.t
 val name : t -> Name.t
 val dir : t -> Path.Source.t
+val exclusive_dir : t -> (Loc.t * Path.Source.t) option
 val set_inside_opam_dir : t -> dir:Path.Source.t -> t
 val encode : Name.t -> t Encoder.t
 val decode : dir:Path.Source.t -> t Decoder.t
@@ -76,6 +70,7 @@ val create
   -> tags:string list
   -> original_opam_file:original_opam_file option
   -> deprecated_package_names:Loc.t Name.Map.t
+  -> contents_basename:(Loc.t * Filename.t) option
   -> t
 
 val original_opam_file : t -> original_opam_file option

src/dune_lang/package_id.ml

@@ -0,0 +1,28 @@
+open Import
+
+module T = struct
+  type t =
+    { name : Package_name.t
+    ; dir : Path.Source.t
+    }
+
+  let compare { name; dir } pkg =
+    match Package_name.compare name pkg.name with
+    | Eq -> Path.Source.compare dir pkg.dir
+    | e -> e
+  ;;
+
+  let to_dyn { dir; name } =
+    Dyn.record [ "name", Package_name.to_dyn name; "dir", Path.Source.to_dyn dir ]
+  ;;
+end
+
+include T
+
+let create ~name ~dir = { name; dir }
+let hash { name; dir } = Tuple.T2.hash Package_name.hash Path.Source.hash (name, dir)
+let name t = t.name
+
+module C = Comparable.Make (T)
+module Set = C.Set
+module Map = C.Map

src/dune_lang/package_id.mli

@@ -0,0 +1,14 @@
+open Import
+
+type t = private
+  { name : Package_name.t
+  ; dir : Path.Source.t
+  }
+
+val create : name:Package_name.t -> dir:Path.Source.t -> t
+val name : t -> Package_name.t
+val hash : t -> int
+val to_dyn : t -> Dyn.t
+val compare : t -> t -> Ordering.t
+
+include Comparable_intf.S with type key := t