feat(pkg): autolocking

Signed-off-by: Ali Caglayan <[email protected]>

Author: Alizter

src/dune_pkg/opam_repo.ml

@@ -128,6 +128,34 @@ let revision t =
   | Directory _ -> Code_error.raise "not a git repo" []
 ;;
 
+let content_digest t =
+  match t.source with
+  | Repo repo ->
+    Rev_store.At_rev.rev repo |> Rev_store.Object.to_hex |> Dune_digest.string
+  | Directory path ->
+    (match Path.lstat path with
+     | Error e ->
+       User_error.raise
+         [ Pp.textf "Can't stat path %s" (Path.to_string path)
+         ; Pp.textf "reason: %s" (Unix_error.Detailed.to_string_hum e)
+         ]
+     | Ok stats ->
+       (match
+          Dune_digest.Stats_for_digest.of_unix_stats stats
+          |> Dune_digest.path_with_stats ~allow_dirs:true path
+        with
+        | Ok digest -> digest
+        | Error (Unix_error e) ->
+          User_error.raise
+            [ Pp.textf "Can't digest path %S:" (Path.to_string path)
+            ; Unix_error.Detailed.pp e
+            ]
+        | Error Unexpected_kind ->
+          User_error.raise
+            [ Pp.textf "Can't digest path %S: unexpected file kind" (Path.to_string path)
+            ]))
+;;
+
 let load_opam_package_from_dir ~(dir : Path.t) package =
   let opam_file_path = Paths.opam_file package in
   match Path.exists (Path.append_local dir opam_file_path) with

src/dune_pkg/opam_repo.mli

@@ -26,6 +26,15 @@ val of_git_repo : Loc.t -> OpamUrl.t -> t Fiber.t
 val revision : t -> Rev_store.At_rev.t
 val serializable : t -> Serializable.t option
 
+(** [content_digest t] digests the contents of an opam repository. For a Git
+    repository, this is a digest of the commit SHA. For a directory-based
+    repository, this is a digest of the directory's contents.
+
+    Raises [User_error] in the directory case if the path cannot be accessed or
+    digested due to permission errors, the directory being deleted or modified
+    between stat and digest, or other filesystem errors. *)
+val content_digest : t -> Dune_digest.t
+
 module Key : sig
   type t
 

src/dune_pkg/package_universe.ml

@@ -134,14 +134,16 @@ let check_for_unnecessary_packges_in_lock_dir
       ])
 ;;
 
-let up_to_date local_packages ~dependency_hash:saved_dependency_hash =
+let dependency_digest local_packages =
   let local_packages =
     Package_name.Map.values local_packages |> List.map ~f:Local_package.for_solver
   in
-  let dependency_hash =
-    Local_package.For_solver.non_local_dependencies local_packages
-    |> Local_package.Dependency_hash.of_dependency_formula
-  in
+  Local_package.For_solver.non_local_dependencies local_packages
+  |> Local_package.Dependency_hash.of_dependency_formula
+;;
+
+let up_to_date local_packages ~dependency_hash:saved_dependency_hash =
+  let dependency_hash = dependency_digest local_packages in
   match saved_dependency_hash, dependency_hash with
   | None, None -> `Valid
   | Some lock_dir_dependency_hash, Some non_local_dependencies_hash

src/dune_pkg/package_universe.mli

@@ -14,6 +14,10 @@ val create
   -> Lock_dir.t
   -> (t, User_message.t) result
 
+val dependency_digest
+  :  Local_package.t Package_name.Map.t
+  -> Local_package.Dependency_hash.t option
+
 (** Verifies if the dependencies described in the project file are still
     synchronized with the dependencies selected in the lock directroy. If it is
     not the case, it returns the hash of the new dependency set. *)

src/dune_pkg/resolved_package.ml

@@ -38,6 +38,11 @@ let opam_file = function
   | Rest t -> t.opam_file
 ;;
 
+let extra_files = function
+  | Dune -> None
+  | Rest t -> Some t.extra_files
+;;
+
 let add_opam_package_to_opam_file package opam_file =
   opam_file
   |> OpamFile.OPAM.with_version (OpamPackage.version package)
@@ -188,3 +193,70 @@ let get_opam_package_files resolved_packages =
     | Some _ -> Some (Option.value files ~default:[]))
   |> Int.Map.values
 ;;
+
+let digest_extra_files : extra_files -> Dune_digest.t = function
+  | Inside_files_dir path_opt ->
+    (match path_opt with
+     | None ->
+       Sexp.List [ Atom "inside_files_dir"; Atom "none" ]
+       |> Sexp.to_string
+       |> Dune_digest.string
+     | Some path ->
+       (match Path.lstat path with
+        | Error e ->
+          User_error.raise
+            [ Pp.textf "Can't stat path %s" (Path.to_string path)
+            ; Pp.textf "reason: %s" (Unix_error.Detailed.to_string_hum e)
+            ]
+        | Ok stats ->
+          let stats_for_digest = Dune_digest.Stats_for_digest.of_unix_stats stats in
+          (match Dune_digest.path_with_stats ~allow_dirs:true path stats_for_digest with
+           | Ok digest -> digest
+           | Error (Unix_error e) ->
+             User_error.raise
+               [ Pp.textf "Can't digest path %S:" (Path.to_string path)
+               ; Unix_error.Detailed.pp e
+               ]
+           | Error Unexpected_kind ->
+             User_error.raise
+               [ Pp.textf
+                   "Can't digest path %S: unexpected file kind"
+                   (Path.to_string path)
+               ])))
+  | Git_files (path_opt, rev) ->
+    let path_str =
+      match path_opt with
+      | None -> "none"
+      | Some p -> Path.Local.to_string p
+    in
+    Sexp.List
+      [ Atom "git_files"
+      ; Atom path_str
+      ; Atom (Rev_store.At_rev.rev rev |> Rev_store.Object.to_hex)
+      ]
+    |> Sexp.to_string
+    |> Dune_digest.string
+;;
+
+let digest res_pkg =
+  Sexp.record
+    [ "opam_file", Atom (OpamFile.OPAM.write_to_string (opam_file res_pkg))
+    ; ( "package"
+      , let opam_pkg = package res_pkg in
+        Sexp.record
+          [ "name", Atom (OpamPackage.name opam_pkg |> OpamPackage.Name.to_string)
+          ; "version", Atom (OpamPackage.version opam_pkg |> OpamPackage.Version.to_string)
+          ] )
+    ; "loc", Atom (loc res_pkg |> Dyn.opaque |> Dyn.to_string)
+    ; "dune_build", Atom (dune_build res_pkg |> Bool.to_string)
+    ; ( "extra_files"
+      , Atom
+          (extra_files res_pkg
+           |> Option.map ~f:digest_extra_files
+           |> Dune_digest.Feed.compute_digest
+                (Dune_digest.Feed.option Dune_digest.Feed.digest)
+           |> Dune_digest.to_string) )
+    ]
+  |> Sexp.to_string
+  |> Dune_digest.string
+;;

src/dune_pkg/resolved_package.mli

@@ -35,3 +35,12 @@ val local_package
 val get_opam_package_files
   :  t list
   -> (File_entry.t list list, User_message.t) result Fiber.t
+
+(** [digest t] computes a digest of the resolved package contents, excluding the
+    source location. For directory-based extra files, the digest of the
+    directory contents is included. For git-based extra files, the commit SHA is
+    included.
+
+    Raises [User_error] if extra files in a directory cannot be accessed or
+    digested due to permission errors, filesystem errors. *)
+val digest : t -> Dune_digest.t

src/dune_rules/lock_dir.ml

@@ -177,22 +177,12 @@ let get_path ctx_name =
       | false -> None
       | true -> Some ctx)
   in
-  let* lock_dir_paths =
-    match ctx with
-    | None | Some (Default { lock_dir = None; _ }) ->
-      Memo.return (Some (default_source_path, default_path))
-    | Some (Default { lock_dir = Some lock_dir_selection; _ }) ->
-      let+ source_lock_dir = select_lock_dir lock_dir_selection in
-      Some (source_lock_dir, lock_dir_of_source source_lock_dir)
-    | Some (Opam _) -> Memo.return None
-  in
-  match lock_dir_paths with
-  | None -> Memo.return None
-  | Some (source_path, lock_dir_path) ->
-    let* in_source_tree = Source_tree.find_dir source_path in
-    (match in_source_tree with
-     | Some _ -> Memo.return (Some lock_dir_path)
-     | None -> Memo.return None)
+  match ctx with
+  | None | Some (Default { lock_dir = None; _ }) -> Memo.return (Some default_path)
+  | Some (Default { lock_dir = Some lock_dir_selection; _ }) ->
+    let+ source_lock_dir = select_lock_dir lock_dir_selection in
+    Some (lock_dir_of_source source_lock_dir)
+  | Some (Opam _) -> Memo.return None
 ;;
 
 let get_workspace_lock_dir ctx =
@@ -250,15 +240,77 @@ let of_dev_tool_if_lock_dir_exists dev_tool =
   else Memo.return None
 ;;
 
+let lock_dirs_of_workspace (workspace : Workspace.t) =
+  let module Set = Path.Source.Set in
+  let+ lock_dirs_from_ctx =
+    Memo.List.map workspace.contexts ~f:(function
+      | Opam _ | Default { lock_dir = None; _ } -> Memo.return None
+      | Default { lock_dir = Some selection; _ } ->
+        let+ path = select_lock_dir selection in
+        Some path)
+    >>| List.filter_opt
+  in
+  match lock_dirs_from_ctx, workspace.lock_dirs with
+  | [], [] -> Set.singleton default_source_path
+  | lock_dirs_from_ctx, lock_dirs_from_toplevel ->
+    let lock_paths_from_toplevel =
+      List.map lock_dirs_from_toplevel ~f:(fun (lock_dir : Workspace.Lock_dir.t) ->
+        lock_dir.path)
+    in
+    Set.union (Set.of_list lock_paths_from_toplevel) (Set.of_list lock_dirs_from_ctx)
+;;
+
+let enabled () =
+  match !Clflags.ignore_lock_dir with
+  | true -> Memo.return false
+  | false ->
+    let* workspace = Workspace.workspace () in
+    (match workspace.config.pkg_enabled with
+     | Set (_, `Enabled) -> Memo.return true
+     | Set (_, `Disabled) -> Memo.return false
+     | Unset ->
+       let* lock_dirs = lock_dirs_of_workspace workspace in
+       Path.Source.Set.to_list lock_dirs
+       |> Memo.List.exists ~f:(fun lock_dir ->
+         Fs_memo.dir_exists (Path.Outside_build_dir.In_source_dir lock_dir)))
+;;
+
+let get_path_if_source_exists ctx_name =
+  let* workspace = Workspace.workspace () in
+  let ctx =
+    List.find_map workspace.contexts ~f:(fun ctx ->
+      match Context_name.equal (Workspace.Context.name ctx) ctx_name with
+      | false -> None
+      | true -> Some ctx)
+  in
+  let* lock_dir_paths =
+    match ctx with
+    | None | Some (Default { lock_dir = None; _ }) ->
+      Memo.return (Some (default_source_path, default_path))
+    | Some (Default { lock_dir = Some lock_dir_selection; _ }) ->
+      let+ source_lock_dir = select_lock_dir lock_dir_selection in
+      Some (source_lock_dir, lock_dir_of_source source_lock_dir)
+    | Some (Opam _) -> Memo.return None
+  in
+  match lock_dir_paths with
+  | None -> Memo.return None
+  | Some (source_path, lock_dir_path) ->
+    let* in_source_tree = Source_tree.find_dir source_path in
+    (match in_source_tree with
+     | Some _ -> Memo.return (Some lock_dir_path)
+     | None -> Memo.return None)
+;;
+
 let lock_dir_active ctx =
   let open Memo.O in
   if !Clflags.ignore_lock_dir
   then Memo.return false
   else
     let* workspace = Workspace.workspace () in
     match workspace.config.pkg_enabled with
+    | Set (_, `Enabled) -> Memo.return true
     | Set (_, `Disabled) -> Memo.return false
-    | Set (_, `Enabled) | Unset -> get_path ctx >>| Option.is_some
+    | Unset -> get_path_if_source_exists ctx >>| Option.is_some
 ;;
 
 let source_kind (source : Dune_pkg.Source.t) =

src/dune_rules/lock_dir.mli

@@ -29,6 +29,11 @@ val dev_tool_lock_dir : Dune_pkg.Dev_tool.t -> Path.t
 
 val select_lock_dir : Workspace.Lock_dir_selection.t -> Path.Source.t Memo.t
 
+(** Returns true if lock dir functionality is active, be it via explicitly
+    opting in via [(pkg enabled)] or inferred through the existence of lock
+    directories *)
+val enabled : unit -> bool Memo.t
+
 module Sys_vars : sig
   type t =
     { os : string option Memo.Lazy.t