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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
open B0_std
open B00
type sel =
[ `Dir of Fpath.t
| `Dir_rec of Fpath.t
| `X of Fpath.t
| `File of Fpath.t
| `Fut of B0_build.t -> Fpath.Set.t Fut.t ]
type sels = sel list
type t =
{ by_ext : B00_fexts.map;
roots : Fpath.t Fpath.Map.t; }
let by_ext s = s.by_ext
let fail_if_error m u = function
| Error e -> Memo.fail m "Source selection: %s" e | Ok v -> v
let select_files m u (seen, by_ext) fs =
let rec loop m u seen by_ext = function
| [] -> seen, by_ext
| f :: fs ->
match Os.File.exists f |> fail_if_error m u with
| false ->
let pp_file = Fmt.(code Fpath.pp) in
Memo.fail m "Source file@ %a@ does not exist." pp_file f
| true ->
if Fpath.Set.mem f seen then loop m u seen by_ext fs else
let seen = Fpath.Set.add f seen in
let by_ext = String.Map.add_to_list (Fpath.get_ext f) f by_ext in
loop m u seen by_ext fs
in
loop m u seen by_ext fs
let select_files_in_dirs m u xs (seen, by_ext as acc) ds =
let exclude =
let ds =
List.fold_left (fun s (d, _) -> Fpath.Set.add d s) Fpath.Set.empty ds
in
fun fname p ->
let auto_exclude = function
| "" | "." | ".." -> false
| s when s.[0] = '.' -> true
| _ -> false
in
if auto_exclude fname then not (Fpath.Set.mem p ds)
else Fpath.Set.mem p xs
in
let add_file st fname p (seen, by_ext as acc) =
if exclude fname p then acc else
match st.Unix.st_kind with
| Unix.S_DIR -> acc
| _ ->
if Fpath.Set.mem p seen then acc else
Fpath.Set.add p seen, String.Map.add_to_list (Fpath.get_ext p) p by_ext
in
let rec loop m u xs (seen, by_ext as acc) = function
| [] -> acc
| (d, recurse) :: ds ->
let d = Fpath.strip_dir_sep d in
if Fpath.Set.mem d xs then loop m u xs acc ds else
match Os.Dir.exists d |> fail_if_error m u with
| false ->
let pp_dir = Fmt.(code Fpath.pp) in
Memo.fail m "Source directory@ %a@ does not exist." pp_dir d
| true ->
let prune _ dname dir _ = exclude dname dir in
let dotfiles = true in
let acc = Os.Dir.fold ~dotfiles ~prune ~recurse add_file d acc in
loop m u xs (acc |> fail_if_error m u) ds
in
loop m u xs acc ds
let select b sels =
let open B0_std.Fut.Syntax in
let m = B0_build.memo b in
let u = B0_build.current b in
let scope = B0_build.current_scope_dir b in
let abs d = Fpath.(scope // d) in
let fs, ds, xs, futs =
let rec loop fs ds xs futs = function
| [] -> fs, ds, xs, futs
| `Dir d :: ss -> loop fs ((abs d, false) :: ds) xs futs ss
| `Dir_rec d :: ss -> loop fs ((abs d, true) :: ds) xs futs ss
| `X x :: ss ->
let x = Fpath.strip_dir_sep (abs x) in
loop fs ds (Fpath.Set.add x xs) futs ss
| `File f :: ss -> loop ((abs f) :: fs) ds xs futs ss
| `Fut f :: ss -> loop fs ds xs (f b :: futs) ss
in
loop [] [] Fpath.Set.empty [] sels
in
let acc = Fpath.Set.empty, String.Map.empty in
let acc = select_files m u acc fs in
let (seen, _ as acc) = select_files_in_dirs m u xs acc ds in
Fpath.Set.iter (Memo.file_ready m) seen;
let* futs = Fut.of_list futs in
let add_files acc files =
let add_file file (seen, by_ext as acc) =
if Fpath.Set.mem file seen then acc else
let ext = Fpath.get_ext file in
let by_ext = String.Map.add_to_list ext file by_ext in
(Fpath.Set.add file seen), by_ext
in
Fpath.Set.fold add_file files acc
in
let _, acc = List.fold_left add_files acc futs in
Fut.return { by_ext = acc; roots = Fpath.Map.empty }