1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
open Import
type checked =
| In_build_dir of (Context.t * Path.Source.t)
| In_private_context of Path.Build.t
| In_install_dir of (Context.t * Path.Source.t)
| In_source_dir of Path.Source.t
| External of Path.External.t
let check_path contexts =
let contexts =
Dune_engine.Context_name.Map.of_list_map_exn contexts ~f:(fun c -> Context.name c, c)
in
fun path ->
let internal_path () =
User_error.raise
[ Pp.textf "This path is internal to dune: %s" (Path.to_string_maybe_quoted path)
]
in
let context_exn ctx =
match Dune_engine.Context_name.Map.find contexts ctx with
| Some context -> context
| None ->
User_error.raise
[ Pp.textf
"%s refers to unknown build context: %s"
(Path.to_string_maybe_quoted path)
(Dune_engine.Context_name.to_string ctx)
]
~hints:
(User_message.did_you_mean
(Dune_engine.Context_name.to_string ctx)
~candidates:
(Dune_engine.Context_name.Map.keys contexts
|> List.map ~f:Dune_engine.Context_name.to_string))
in
match path with
| External e -> External e
| In_source_tree s -> In_source_dir s
| In_build_dir path ->
(match Dune_engine.Dpath.analyse_target path with
| Other _ -> internal_path ()
| Alias (_, _) -> internal_path ()
| Anonymous_action _ -> internal_path ()
| Regular (name, src) ->
(match Install.Context.analyze_path name src with
| Invalid -> internal_path ()
| Install (ctx, path) -> In_install_dir (context_exn ctx, path)
| Normal (ctx, path) ->
if Context_name.equal ctx Dune_rules.Private_context.t.name
then
In_private_context
(Path.Build.append_source Dune_rules.Private_context.t.build_dir path)
else In_build_dir (context_exn ctx, path)))
;;
|
