Skip to content

Commit 969adfe

Browse files
Leonidas-from-XIVLeonidas-from-XIV
committed
Split out lock rules
1 parent 01f2b01 commit 969adfe

File tree

5 files changed

+84
-55
lines changed

5 files changed

+84
-55
lines changed

‎src/dune_rules/gen_rules.ml‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -645,7 +645,11 @@ let private_context ~dir components _ctx =
645645
analyze_private_context_path components
646646
>>= function
647647
| `Invalid_context -> Memo.return Gen_rules.unknown_context
648-
| `Valid (ctx, components) -> Pkg_rules.setup_rules ctx ~dir ~components
648+
| `Valid (ctx, components) ->
649+
(* TODO link up lock_rules *)
650+
let+ lock_rules = Lock_rules.setup_rules ctx ~dir ~components
651+
and+ pkg_rules = Pkg_rules.setup_rules ctx ~dir ~components in
652+
Gen_rules.combine lock_rules pkg_rules
649653
| `Root ->
650654
let+ contexts = Per_context.list () in
651655
let build_dir_only_sub_dirs =
@@ -716,7 +720,7 @@ let gen_rules ctx ~dir components =
716720
else
717721
let* () = raise_on_lock_dir_out_of_sync ctx in
718722
let gen_pkg_alias_rule = Pkg_rules.setup_pkg_install_alias ~dir ctx in
719-
let gen_lock_rule = Pkg_rules.setup_tmp_lock_alias ~dir ctx in
723+
let gen_lock_rule = Lock_rules.setup_tmp_lock_alias ~dir ctx in
720724
let+ sctx_rules = gen_rules ctx (Super_context.find_exn ctx) ~dir components in
721725
Gen_rules.combine (Gen_rules.combine sctx_rules gen_pkg_alias_rule) gen_lock_rule
722726
;;

‎src/dune_rules/lock_rules.ml‎

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
open Import
2+
open Memo.O
23

34
module Spec = struct
45
type ('path, 'target) t =
@@ -39,3 +40,70 @@ let lock ~target ~lock_dir =
3940
|> Action_builder.With_targets.return
4041
|> Action_builder.With_targets.add_directories ~directory_targets:[ target ]
4142
;;
43+
44+
module Gen_rules = Build_config.Gen_rules
45+
46+
let lock_rule ~target lock_dir = lock ~target ~lock_dir |> Memo.return
47+
48+
let rule ?loc { Action_builder.With_targets.build; targets } =
49+
(* TODO this ignores the workspace file *)
50+
Rule.make ~info:(Rule.Info.of_loc_opt loc) ~targets build |> Rules.Produce.rule
51+
;;
52+
53+
let setup_lock_rules ctx_name ~lock_dir : Gen_rules.result =
54+
let target =
55+
let ( / ) = Path.Build.relative in
56+
Private_context.t.build_dir
57+
/ Context_name.to_string ctx_name
58+
/ ".lock"
59+
/ lock_dir
60+
/ "content"
61+
in
62+
let gen_rules lock_dir =
63+
let* lock_rule = lock_rule ~target lock_dir in
64+
rule ~loc:Loc.none lock_rule
65+
in
66+
let rules = Rules.collect_unit (fun () -> gen_rules lock_dir) in
67+
let directory_targets = Path.Build.Map.singleton target Loc.none in
68+
Gen_rules.make ~directory_targets rules
69+
;;
70+
71+
let setup_rules ~components ~dir ctx =
72+
match components with
73+
| [ ".lock" ] ->
74+
Gen_rules.make
75+
~build_dir_only_sub_dirs:
76+
(Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.all)
77+
(Memo.return Rules.empty)
78+
|> Memo.return
79+
| [ ".lock"; lock_dir ] -> Memo.return @@ setup_lock_rules ctx ~lock_dir
80+
| [] ->
81+
let sub_dirs = [ ".lock" ] in
82+
let build_dir_only_sub_dirs =
83+
Gen_rules.Build_only_sub_dirs.singleton ~dir @@ Subdir_set.of_list sub_dirs
84+
in
85+
Memo.return @@ Gen_rules.make ~build_dir_only_sub_dirs (Memo.return Rules.empty)
86+
| _ -> Memo.return @@ Gen_rules.rules_here Gen_rules.Rules.empty
87+
;;
88+
89+
let setup_tmp_lock_alias =
90+
fun ~dir ctx_name ->
91+
let alias = Alias.make ~dir Alias0.pkg_lock in
92+
let rule =
93+
Rules.collect_unit (fun () ->
94+
(* careful, need to point to a file that will be created by the rule *)
95+
let path =
96+
let ( / ) = Path.Build.relative in
97+
(* TODO get lock dir name instead of hardcoding `dune.lock` *)
98+
Private_context.t.build_dir
99+
/ Context_name.to_string ctx_name
100+
/ ".lock"
101+
/ "dune.lock"
102+
/ "content"
103+
in
104+
let deps = Action_builder.path (Path.build path) in
105+
Rules.Produce.Alias.add_deps alias deps)
106+
in
107+
Gen_rules.rules_for ~dir ~allowed_subdirs:Filename.Set.empty rule
108+
|> Gen_rules.rules_here
109+
;;

‎src/dune_rules/lock_rules.mli‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,11 @@
11
open Import
22

3-
val lock : target:Path.Build.t -> lock_dir:string -> Action.Full.t With_targets.t
3+
(* val lock : target:Path.Build.t -> lock_dir:string -> Action.Full.t With_targets.t *)
4+
5+
val setup_rules
6+
: components:string list
7+
-> dir:Path.Build.t (* -> Super_context.t Memo.t *)
8+
-> Context_name.t
9+
-> Build_config.Gen_rules.t Memo.t
10+
11+
val setup_tmp_lock_alias : dir:Path.Build.t -> Context_name.t -> Build_config.Gen_rules.t

‎src/dune_rules/pkg_rules.ml‎

Lines changed: 1 addition & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -1892,48 +1892,6 @@ let setup_pkg_install_alias =
18921892
|> Gen_rules.rules_here
18931893
;;
18941894

1895-
let setup_tmp_lock_alias =
1896-
fun ~dir ctx_name ->
1897-
let alias = Alias.make ~dir Alias0.pkg_lock in
1898-
let rule =
1899-
Rules.collect_unit (fun () ->
1900-
(* careful, need to point to a file that will be created by the rule *)
1901-
let path =
1902-
let ( / ) = Path.Build.relative in
1903-
(* TODO get lock dir name instead of hardcoding `dune.lock` *)
1904-
Private_context.t.build_dir
1905-
/ Context_name.to_string ctx_name
1906-
/ ".lock"
1907-
/ "dune.lock"
1908-
/ "content"
1909-
in
1910-
let deps = Action_builder.path (Path.build path) in
1911-
Rules.Produce.Alias.add_deps alias deps)
1912-
in
1913-
Gen_rules.rules_for ~dir ~allowed_subdirs:Filename.Set.empty rule
1914-
|> Gen_rules.rules_here
1915-
;;
1916-
1917-
let lock_rule ~target lock_dir = Lock_rules.lock ~target ~lock_dir |> Memo.return
1918-
1919-
let setup_lock_rules ctx_name ~lock_dir : Gen_rules.result =
1920-
let target =
1921-
let ( / ) = Path.Build.relative in
1922-
Private_context.t.build_dir
1923-
/ Context_name.to_string ctx_name
1924-
/ ".lock"
1925-
/ lock_dir
1926-
/ "content"
1927-
in
1928-
let gen_rules lock_dir =
1929-
let* lock_rule = lock_rule ~target lock_dir in
1930-
rule ~loc:Loc.none lock_rule
1931-
in
1932-
let rules = Rules.collect_unit (fun () -> gen_rules lock_dir) in
1933-
let directory_targets = Path.Build.Map.singleton target Loc.none in
1934-
Gen_rules.make ~directory_targets rules
1935-
;;
1936-
19371895
let setup_package_rules ~package_universe ~dir ~pkg_name : Gen_rules.result Memo.t =
19381896
let name = User_error.ok_exn (Package.Name.of_string_user_error (Loc.none, pkg_name)) in
19391897
let* db = DB.get package_universe in
@@ -2003,15 +1961,8 @@ let setup_rules ~components ~dir ctx =
20031961
Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty
20041962
| true, ".dev-tool" :: _ :: _ :: _ ->
20051963
Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty
2006-
| _, [ ".lock" ] ->
2007-
Gen_rules.make
2008-
~build_dir_only_sub_dirs:
2009-
(Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.all)
2010-
(Memo.return Rules.empty)
2011-
|> Memo.return
2012-
| _, [ ".lock"; lock_dir ] -> Memo.return @@ setup_lock_rules ctx ~lock_dir
20131964
| is_default, [] ->
2014-
let sub_dirs = ".pkg" :: ".lock" :: (if is_default then [ ".dev-tool" ] else []) in
1965+
let sub_dirs = ".pkg" :: (if is_default then [ ".dev-tool" ] else []) in
20151966
let build_dir_only_sub_dirs =
20161967
Gen_rules.Build_only_sub_dirs.singleton ~dir @@ Subdir_set.of_list sub_dirs
20171968
in

‎src/dune_rules/pkg_rules.mli‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,5 +32,3 @@ val setup_pkg_install_alias
3232
: dir:Path.Build.t
3333
-> Context_name.t
3434
-> Build_config.Gen_rules.t
35-
36-
val setup_tmp_lock_alias : dir:Path.Build.t -> Context_name.t -> Build_config.Gen_rules.t

0 commit comments

Comments
 (0)