Create directory target to write lock file into

Signed-off-by: Marek Kubica <[email protected]>

Author: Leonidas-from-XIV

src/dune_rules/alias0.ml

@@ -24,6 +24,7 @@ let doc_new = standard "doc-new"
 let check = standard "check"
 let install = standard "install"
 let pkg_install = Alias.Name.of_string "pkg-install"
+let pkg_lock = Alias.Name.of_string "pkg-lock"
 let ocaml_index = standard "ocaml-index"
 let runtest = standard "runtest"
 let all = standard "all"

src/dune_rules/alias0.mli

@@ -14,6 +14,7 @@ val check : Name.t
 val ocaml_index : Name.t
 val install : Name.t
 val pkg_install : Name.t
+val pkg_lock : Name.t
 val runtest : Name.t
 val all : Name.t
 val default : Name.t

src/dune_rules/gen_rules.ml

@@ -716,6 +716,7 @@ let gen_rules ctx ~dir components =
   else
     let* () = raise_on_lock_dir_out_of_sync ctx in
     let gen_pkg_alias_rule = Pkg_rules.setup_pkg_install_alias ~dir ctx in
+    let gen_lock_rule = Pkg_rules.setup_tmp_lock_alias ~dir ctx in
     let+ sctx_rules = gen_rules ctx (Super_context.find_exn ctx) ~dir components in
-    Gen_rules.combine sctx_rules gen_pkg_alias_rule
+    Gen_rules.combine (Gen_rules.combine sctx_rules gen_pkg_alias_rule) gen_lock_rule
 ;;

src/dune_rules/lock_rules.ml

@@ -0,0 +1,41 @@
+open Import
+
+module Spec = struct
+  type ('path, 'target) t =
+    { target : 'target
+    ; lock_dir : string
+    }
+
+  let name = "lock"
+  let version = 1
+  let bimap t _ g = { t with target = g t.target }
+  let is_useful_to ~memoize = memoize
+
+  let encode { target; lock_dir } _encode_path encode_target : Sexp.t =
+    Sexp.List [ encode_target target; Sexp.Atom lock_dir ]
+  ;;
+
+  let action { target; lock_dir } ~ectx:_ ~eenv:_ =
+    let open Fiber.O in
+    let+ () = Fiber.return () in
+    Printf.eprintf
+      "Our ACTION target is %s, our lock_dir is %S\n"
+      (Path.Build.to_string target)
+      lock_dir;
+    let path = Path.build target in
+    Path.mkdir_p path;
+    Io.write_file ~binary:true (Path.relative path "lock.dune") "Hello I exist";
+    ()
+  ;;
+end
+
+module A = Action_ext.Make (Spec)
+
+let action ~target ~lock_dir = A.action { Spec.target; lock_dir }
+
+let lock ~target ~lock_dir =
+  action ~target ~lock_dir
+  |> Action.Full.make ~can_go_in_shared_cache:true
+  |> Action_builder.With_targets.return
+  |> Action_builder.With_targets.add_directories ~directory_targets:[ target ]
+;;

src/dune_rules/lock_rules.mli

@@ -0,0 +1,3 @@
+open Import
+
+val lock : target:Path.Build.t -> lock_dir:string -> Action.Full.t With_targets.t

src/dune_rules/pkg_rules.ml

@@ -1892,6 +1892,48 @@ let setup_pkg_install_alias =
     |> Gen_rules.rules_here
 ;;
 
+let setup_tmp_lock_alias =
+  fun ~dir ctx_name ->
+  let alias = Alias.make ~dir Alias0.pkg_lock in
+  let rule =
+    Rules.collect_unit (fun () ->
+      (* careful, need to point to a file that will be created by the rule *)
+      let path =
+        let ( / ) = Path.Build.relative in
+        (* TODO get lock dir name instead of hardcoding `dune.lock` *)
+        Private_context.t.build_dir
+        / Context_name.to_string ctx_name
+        / ".lock"
+        / "dune.lock"
+        / "content"
+      in
+      let deps = Action_builder.path (Path.build path) in
+      Rules.Produce.Alias.add_deps alias deps)
+  in
+  Gen_rules.rules_for ~dir ~allowed_subdirs:Filename.Set.empty rule
+  |> Gen_rules.rules_here
+;;
+
+let lock_rule ~target lock_dir = Lock_rules.lock ~target ~lock_dir |> Memo.return
+
+let setup_lock_rules ctx_name ~lock_dir : Gen_rules.result =
+  let target =
+    let ( / ) = Path.Build.relative in
+    Private_context.t.build_dir
+    / Context_name.to_string ctx_name
+    / ".lock"
+    / lock_dir
+    / "content"
+  in
+  let gen_rules lock_dir =
+    let* lock_rule = lock_rule ~target lock_dir in
+    rule ~loc:Loc.none lock_rule
+  in
+  let rules = Rules.collect_unit (fun () -> gen_rules lock_dir) in
+  let directory_targets = Path.Build.Map.singleton target Loc.none in
+  Gen_rules.make ~directory_targets rules
+;;
+
 let setup_package_rules ~package_universe ~dir ~pkg_name : Gen_rules.result Memo.t =
   let name = User_error.ok_exn (Package.Name.of_string_user_error (Loc.none, pkg_name)) in
   let* db = DB.get package_universe in
@@ -1961,8 +2003,15 @@ let setup_rules ~components ~dir ctx =
     Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty
   | true, ".dev-tool" :: _ :: _ :: _ ->
     Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty
+  | _, [ ".lock" ] ->
+    Gen_rules.make
+      ~build_dir_only_sub_dirs:
+        (Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.all)
+      (Memo.return Rules.empty)
+    |> Memo.return
+  | _, [ ".lock"; lock_dir ] -> Memo.return @@ setup_lock_rules ctx ~lock_dir
   | is_default, [] ->
-    let sub_dirs = ".pkg" :: (if is_default then [ ".dev-tool" ] else []) in
+    let sub_dirs = ".pkg" :: ".lock" :: (if is_default then [ ".dev-tool" ] else []) in
     let build_dir_only_sub_dirs =
       Gen_rules.Build_only_sub_dirs.singleton ~dir @@ Subdir_set.of_list sub_dirs
     in

src/dune_rules/pkg_rules.mli

@@ -32,3 +32,5 @@ val setup_pkg_install_alias
   :  dir:Path.Build.t
   -> Context_name.t
   -> Build_config.Gen_rules.t
+
+val setup_tmp_lock_alias : dir:Path.Build.t -> Context_name.t -> Build_config.Gen_rules.t