2424
2525let flag_concat flag xs =
2626 String. concat Ext_string. single_space
27- (Ext_list. flat_map xs (fun x -> [ flag; x ]))
27+ (Ext_list. flat_map xs (fun x -> [flag; x]))
2828
2929let ( // ) = Ext_path. combine
3030
@@ -42,11 +42,11 @@ let pp_flag (xs : string) = "-pp " ^ Ext_filename.maybe_quote xs
4242
4343let include_dirs dirs =
4444 String. concat Ext_string. single_space
45- (Ext_list. flat_map dirs (fun x -> [ " -I" ; Ext_filename. maybe_quote x ]))
45+ (Ext_list. flat_map dirs (fun x -> [" -I" ; Ext_filename. maybe_quote x]))
4646
4747let include_dirs_by dirs fn =
4848 String. concat Ext_string. single_space
49- (Ext_list. flat_map dirs (fun x -> [ " -I" ; Ext_filename. maybe_quote (fn x) ]))
49+ (Ext_list. flat_map dirs (fun x -> [" -I" ; Ext_filename. maybe_quote (fn x)]))
5050
5151(* we use lazy $src_root_dir *)
5252
@@ -64,7 +64,7 @@ let convert_and_resolve_path : string -> string -> string =
6464 else failwith (" Unknown OS :" ^ Sys. os_type)
6565(* we only need convert the path in the beginning *)
6666
67- type result = { path : string ; checked : bool }
67+ type result = {path : string ; checked : bool }
6868
6969(* Magic path resolution:
7070 foo => foo
@@ -78,7 +78,7 @@ let resolve_bsb_magic_file ~cwd ~desc p : result =
7878 let no_slash = Ext_string. no_slash_idx p in
7979 if no_slash < 0 then
8080 (* Single file FIXME: better error message for "" input *)
81- { path = p; checked = false }
81+ {path = p; checked = false }
8282 else
8383 let first_char = String. unsafe_get p 0 in
8484 if Filename. is_relative p && first_char <> '.' then
@@ -91,13 +91,13 @@ let resolve_bsb_magic_file ~cwd ~desc p : result =
9191 (* let p = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_slash_backward p else p in *)
9292 let package_dir = Bsb_pkg. resolve_bs_package ~cwd package_name in
9393 let path = package_dir // relative_path in
94- if Sys. file_exists path then { path; checked = true }
94+ if Sys. file_exists path then {path; checked = true }
9595 else (
9696 Bsb_log. error " @{<error>Could not resolve @} %s in %s@." p cwd;
9797 failwith (p ^ " not found when resolving " ^ desc))
9898 else
9999 (* relative path [./x/y]*)
100- { path = convert_and_resolve_path cwd p; checked = true }
100+ {path = convert_and_resolve_path cwd p; checked = true }
101101
102102(* * converting a file from Linux path format to Windows *)
103103
@@ -121,7 +121,9 @@ let rec mkp dir =
121121
122122let get_list_string_acc (s : Ext_json_types.t array ) acc =
123123 Ext_array. to_list_map_acc s acc (fun x ->
124- match x with Str x -> Some x.str | _ -> None )
124+ match x with
125+ | Str x -> Some x.str
126+ | _ -> None )
125127
126128let get_list_string s = get_list_string_acc s []
127129
@@ -130,7 +132,7 @@ let ( |? ) m (key, cb) = m |> Ext_json.test key cb
130132
131133type top = Expect_none | Expect_name of string
132134
133- type package_context = { proj_dir : string ; top : top ; is_pinned : bool }
135+ type package_context = {proj_dir : string ; top : top ; is_pinned : bool }
134136
135137(* *
136138 TODO: check duplicate package name
@@ -146,79 +148,82 @@ type package_context = { proj_dir : string; top : top; is_pinned: bool }
146148let pp_packages_rev ppf lst =
147149 Ext_list. rev_iter lst (fun s -> Format. fprintf ppf " %s " s)
148150
149- let extract_pinned_dependencies (map : Ext_json_types.t Map_string.t ) : Set_string.t =
151+ let extract_pinned_dependencies (map : Ext_json_types.t Map_string.t ) :
152+ Set_string. t =
150153 match Map_string. find_opt map Bsb_build_schemas. pinned_dependencies with
151154 | None -> Set_string. empty
152- | Some (Arr { content } ) ->
153- Set_string. of_list (get_list_string content)
155+ | Some (Arr {content} ) -> Set_string. of_list (get_list_string content)
154156 | Some config -> Bsb_exception. config_error config " expect an array of string"
155157
156158let rec walk_all_deps_aux (visited : string Hash_string.t ) (paths : string list )
157159 ~(top : top ) (dir : string ) (queue : _ Queue.t ) ~pinned_dependencies =
158- match Bsb_config_load. load_json ~per_proj_dir: dir ~warn_legacy_config: false with
159- | _ , Obj { map; loc } ->
160- let cur_package_name =
161- match Map_string. find_opt map Bsb_build_schemas. name with
162- | Some (Str { str; loc } ) ->
163- (match top with
164- | Expect_none -> ()
165- | Expect_name s ->
166- if s <> str then
167- Bsb_exception. errorf ~loc
168- " package name is expected to be %s but got %s" s str);
169- str
170- | Some _ | None ->
171- Bsb_exception. errorf ~loc " package name missing in %s/bsconfig.json"
172- dir
160+ match
161+ Bsb_config_load. load_json ~per_proj_dir: dir ~warn_legacy_config: false
162+ with
163+ | _ , Obj {map; loc} ->
164+ let cur_package_name =
165+ match Map_string. find_opt map Bsb_build_schemas. name with
166+ | Some (Str {str; loc} ) ->
167+ (match top with
168+ | Expect_none -> ()
169+ | Expect_name s ->
170+ if s <> str then
171+ Bsb_exception. errorf ~loc
172+ " package name is expected to be %s but got %s" s str);
173+ str
174+ | Some _ | None ->
175+ Bsb_exception. errorf ~loc " package name missing in %s/bsconfig.json" dir
176+ in
177+ if Ext_list. mem_string paths cur_package_name then (
178+ Bsb_log. error " @{<error>Cyclic dependencies in package stack@}@." ;
179+ exit 2 );
180+ let package_stacks = cur_package_name :: paths in
181+ Bsb_log. info " @{<info>Package stack:@} %a @." pp_packages_rev package_stacks;
182+ if Hash_string. mem visited cur_package_name then
183+ Bsb_log. info " @{<info>Visited before@} %s@." cur_package_name
184+ else
185+ let explore_deps (deps : string ) pinned_dependencies =
186+ map
187+ |? ( deps,
188+ `Arr
189+ (fun (new_packages : Ext_json_types.t array ) ->
190+ Ext_array. iter new_packages (fun js ->
191+ match js with
192+ | Str {str = new_package } ->
193+ let package_dir =
194+ Bsb_pkg. resolve_bs_package ~cwd: dir
195+ (Bsb_pkg_types. string_as_package new_package)
196+ in
197+ walk_all_deps_aux visited package_stacks
198+ ~top: (Expect_name new_package) package_dir queue
199+ ~pinned_dependencies
200+ | _ -> Bsb_exception. errorf ~loc " %s expect an array" deps))
201+ )
202+ |> ignore
173203 in
174- if Ext_list. mem_string paths cur_package_name then (
175- Bsb_log. error " @{<error>Cyclic dependencies in package stack@}@." ;
176- exit 2 );
177- let package_stacks = cur_package_name :: paths in
178- Bsb_log. info " @{<info>Package stack:@} %a @." pp_packages_rev
179- package_stacks;
180- if Hash_string. mem visited cur_package_name then
181- Bsb_log. info " @{<info>Visited before@} %s@." cur_package_name
182- else
183- let explore_deps (deps : string ) pinned_dependencies =
184- map
185- |? ( deps,
186- `Arr
187- (fun (new_packages : Ext_json_types.t array ) ->
188- Ext_array. iter new_packages (fun js ->
189- match js with
190- | Str { str = new_package } ->
191- let package_dir =
192- Bsb_pkg. resolve_bs_package ~cwd: dir
193- (Bsb_pkg_types. string_as_package new_package)
194- in
195- walk_all_deps_aux visited package_stacks
196- ~top: (Expect_name new_package) package_dir queue
197- ~pinned_dependencies
198- | _ ->
199- Bsb_exception. errorf ~loc " %s expect an array" deps))
200- )
201- |> ignore
202- in
203- let is_pinned = match top with
204+ let is_pinned =
205+ match top with
204206 | Expect_name n when Set_string. mem pinned_dependencies n -> true
205207 | _ -> false
206- in
207- let pinned_dependencies = match is_pinned with
208+ in
209+ let pinned_dependencies =
210+ match is_pinned with
208211 | true ->
209- let transitive_pinned_dependencies = extract_pinned_dependencies map
212+ let transitive_pinned_dependencies =
213+ extract_pinned_dependencies map
210214 in
211215 Set_string. union transitive_pinned_dependencies pinned_dependencies
212216 | false -> pinned_dependencies
213- in
214- explore_deps Bsb_build_schemas. bs_dependencies pinned_dependencies;
215- (match top with
216- | Expect_none -> explore_deps Bsb_build_schemas. bs_dev_dependencies pinned_dependencies
217- | Expect_name _ when is_pinned ->
218- explore_deps Bsb_build_schemas. bs_dev_dependencies pinned_dependencies
219- | Expect_name _ -> () );
220- Queue. add { top; proj_dir = dir; is_pinned } queue;
221- Hash_string. add visited cur_package_name dir
217+ in
218+ explore_deps Bsb_build_schemas. bs_dependencies pinned_dependencies;
219+ (match top with
220+ | Expect_none ->
221+ explore_deps Bsb_build_schemas. bs_dev_dependencies pinned_dependencies
222+ | Expect_name _ when is_pinned ->
223+ explore_deps Bsb_build_schemas. bs_dev_dependencies pinned_dependencies
224+ | Expect_name _ -> () );
225+ Queue. add {top; proj_dir = dir; is_pinned} queue;
226+ Hash_string. add visited cur_package_name dir
222227 | _ -> ()
223228
224229let walk_all_deps dir ~pinned_dependencies : package_context Queue. t =
0 commit comments