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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
open Stdune
module Kind = struct
type t =
| Explicit
| Dune_workspace
| Dune_project
| Cwd
let priority = function
| Explicit -> 0
| Dune_workspace -> 1
| Dune_project -> 2
| Cwd -> 3
;;
let lowest_priority = max_int
let of_dir_contents files =
if String.Set.mem files Source.Workspace.filename
then Some Dune_workspace
else if Filename.Set.mem files Dune_lang.Dune_project.filename
then Some Dune_project
else None
;;
end
type t =
{ dir : string
; to_cwd : string list
; reach_from_root_prefix : string
; kind : Kind.t
}
module Candidate = struct
type t =
{ dir : string
; to_cwd : string list
; kind : Kind.t
}
end
let find () =
let cwd = Sys.getcwd () in
let rec loop counter ~(candidate : Candidate.t option) ~to_cwd dir : Candidate.t option =
match Sys.readdir dir with
| exception Sys_error msg ->
User_warning.emit
[ Pp.textf
"Unable to read directory %s. Will not look for root in parent directories."
dir
; Pp.textf "Reason: %s" msg
; Pp.text "To remove this warning, set your root explicitly using --root."
];
candidate
| files ->
let files = String.Set.of_list (Array.to_list files) in
let candidate =
let candidate_priority =
match candidate with
| Some c -> Kind.priority c.kind
| None -> Kind.lowest_priority
in
match Kind.of_dir_contents files with
| Some kind when Kind.priority kind <= candidate_priority ->
Some { Candidate.kind; dir; to_cwd }
| _ -> candidate
in
cont counter ~candidate dir ~to_cwd
and cont counter ~candidate ~to_cwd dir =
if counter > String.length cwd
then candidate
else (
let parent = Filename.dirname dir in
if parent = dir
then candidate
else (
let base = Filename.basename dir in
loop (counter + 1) parent ~candidate ~to_cwd:(base :: to_cwd)))
in
loop 0 ~to_cwd:[] cwd ~candidate:None
;;
let create ~default_is_cwd ~specified_by_user =
match
match specified_by_user with
| Some dn -> Some { Candidate.kind = Explicit; dir = dn; to_cwd = [] }
| None ->
let cwd = { Candidate.kind = Cwd; dir = "."; to_cwd = [] } in
if Execution_env.inside_dune
then Some cwd
else (
match find () with
| Some s -> Some s
| None -> if default_is_cwd then Some cwd else None)
with
| Some { Candidate.dir; to_cwd; kind } ->
Ok
{ kind
; dir
; to_cwd
; reach_from_root_prefix =
String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
}
| None ->
Error
User_error.(
make
[ Pp.text "I cannot find the root of the current workspace/project."
; Pp.text "If you would like to create a new dune project, you can type:"
; Pp.nop
; Pp.verbatim " dune init project NAME"
; Pp.nop
; Pp.text
"Otherwise, please make sure to run dune inside an existing project or \
workspace. For more information about how dune identifies the root of the \
current workspace/project, please refer to \
https://dune.readthedocs.io/en/stable/usage.html#finding-the-root"
])
;;
let create_exn ~default_is_cwd ~specified_by_user =
match create ~default_is_cwd ~specified_by_user with
| Ok x -> x
| Error e -> raise (User_error.E e)
;;
|
